0f9b048 · elk · git.iko.soy

git.iko.soy/elk

Switch Type/ over to Data.Name

commit0f9b04820d1de05b9e3e0882a692fe58cf367da2 authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 19 Nov 2018, 12:46 (8 years ago) parent36b505f

8 files changed+133−139

compare with master

unifiedsplit

compiler/src/Type/Constrain/Expression.hs+13−13 compiler/src/Type/Constrain/Module.hs+12−12 compiler/src/Type/Constrain/Pattern.hs+7−7 compiler/src/Type/Error.hs+34−34 compiler/src/Type/Instantiate.hs+4−4 compiler/src/Type/Solve.hs+13−13 compiler/src/Type/Type.hs+39−45 compiler/src/Type/Unify.hs+11−11

compiler/src/Type/Constrain/Expression.hs+13−13

@@ -8,12 +8,12 @@ module Type.Constrain.Expression

1010import qualified Data.Map.Strict as Map

11+import qualified Data.Name as Name

1112

1213import qualified AST.Canonical as Can

1314import qualified AST.Module.Name as ModuleName

1415import qualified AST.Utils.Shader as Shader

1516import qualified Data.Index as Index

16−import qualified Elm.Name as N

1717import qualified Reporting.Annotation as A

1818import qualified Reporting.Error.Type as E

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

@@ -35,7 +35,7 @@ import Type.Type as Type hiding (Descriptor(..))

3535-- dictionary will hold variables for `a` and `b`

3636--

3737type RTV =

38− Map.Map N.Name Type

38+ Map.Map Name.Name Type

3939

4040

4141constrain :: RTV -> Can.Expr -> Expected Type -> IO Constraint

@@ -228,7 +228,7 @@ getName (A.At _ expr) =

228228 _ -> NoName

229229

230230

231−getAccessName :: Can.Expr -> Maybe N.Name

231+getAccessName :: Can.Expr -> Maybe Name.Name

232232getAccessName (A.At _ expr) =

233233 case expr of

234234 Can.VarLocal name -> Just name

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

241241-- CONSTRAIN BINOP

242242

243243

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

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

245245constrainBinop rtv region op annotation leftExpr rightExpr expected =

246246 do leftVar <- mkFlexVar

247247 rightVar <- mkFlexVar

@@ -273,7 +273,7 @@ constrainList :: RTV -> R.Region -> [Can.Expr] -> Expected Type -> IO Constraint

273273constrainList rtv region entries expected =

274274 do entryVar <- mkFlexVar

275275 let entryType = VarN entryVar

276− let listType = AppN ModuleName.list N.list [entryType]

276+ let listType = AppN ModuleName.list Name.list [entryType]

277277

278278 entryCons <-

279279 Index.indexedTraverse (constrainListEntry rtv region entryType) entries

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

376376-- CONSTRAIN RECORD

377377

378378

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

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

380380constrainRecord rtv region fields expected =

381381 do dict <- traverse (constrainField rtv) fields

382382

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

402402-- CONSTRAIN RECORD UPDATE

403403

404404

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

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

406406constrainUpdate rtv region name expr fields expected =

407407 do extVar <- mkFlexVar

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

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

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

424424

425425

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

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

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

428428 do var <- mkFlexVar

429429 let tipe = VarN var

@@ -475,7 +475,7 @@ constrainShader region (Shader.Shader attributes uniforms varyings) expected =

475475 let unifType = VarN unifVar

476476

477477 let shaderType =

478− AppN ModuleName.webgl N.shader

478+ AppN ModuleName.webgl Name.shader

479479 [ toShaderRecord attributes attrType

480480 , toShaderRecord uniforms unifType

481481 , toShaderRecord varyings EmptyRecordN

@@ -485,7 +485,7 @@ constrainShader region (Shader.Shader attributes uniforms varyings) expected =

485485 CEqual region Shader shaderType expected

486486

487487

488−toShaderRecord :: Map.Map N.Name Shader.Type -> Type -> Type

488+toShaderRecord :: Map.Map Name.Name Shader.Type -> Type -> Type

489489toShaderRecord types baseRecType =

490490 if Map.null types then

491491 baseRecType

@@ -590,7 +590,7 @@ data Info =

590590 Info

591591 { _vars :: [Variable]

592592 , _cons :: [Constraint]

593− , _headers :: Map.Map N.Name (A.Located Type)

593+ , _headers :: Map.Map Name.Name (A.Located Type)

594594 }

595595

596596

@@ -724,12 +724,12 @@ data TypedArgs =

724724 }

725725

726726

727−constrainTypedArgs :: Map.Map N.Name Type -> N.Name -> [(Can.Pattern, Can.Type)] -> Can.Type -> IO TypedArgs

727+constrainTypedArgs :: Map.Map Name.Name Type -> Name.Name -> [(Can.Pattern, Can.Type)] -> Can.Type -> IO TypedArgs

728728constrainTypedArgs rtv name args srcResultType =

729729 typedArgsHelp rtv name Index.first args srcResultType Pattern.emptyState

730730

731731

732−typedArgsHelp :: Map.Map N.Name Type -> N.Name -> Index.ZeroBased -> [(Can.Pattern, Can.Type)] -> Can.Type -> Pattern.State -> IO TypedArgs

732+typedArgsHelp :: Map.Map Name.Name Type -> Name.Name -> Index.ZeroBased -> [(Can.Pattern, Can.Type)] -> Can.Type -> Pattern.State -> IO TypedArgs

733733typedArgsHelp rtv name index args srcResultType state =

734734 case args of

735735 [] ->

compiler/src/Type/Constrain/Module.hs+12−12

@@ -7,10 +7,10 @@ module Type.Constrain.Module

99import qualified Data.Map.Strict as Map

10+import qualified Data.Name as Name

1011

1112import qualified AST.Canonical as Can

1213import qualified AST.Module.Name as ModuleName

13−import qualified Elm.Name as N

1414import qualified Reporting.Annotation as A

1515import qualified Reporting.Error.Type as E

1616import qualified Reporting.Region as R

@@ -69,7 +69,7 @@ constrainDecls decls finalConstraint =

6969-- PORT HELPERS

7070

7171

72−letPort :: N.Name -> Can.Port -> IO Constraint -> IO Constraint

72+letPort :: Name.Name -> Can.Port -> IO Constraint -> IO Constraint

7373letPort name port_ makeConstraint =

7474 case port_ of

7575 Can.Incoming freeVars _ srcType ->

@@ -89,20 +89,20 @@ letPort name port_ makeConstraint =

8989-- EFFECT MANAGER HELPERS

9090

9191

92−letCmd :: ModuleName.Canonical -> N.Name -> Constraint -> IO Constraint

92+letCmd :: ModuleName.Canonical -> Name.Name -> Constraint -> IO Constraint

9393letCmd home tipe constraint =

9494 do msgVar <- mkFlexVar

9595 let msg = VarN msgVar

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

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

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

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

9999

100100

101−letSub :: ModuleName.Canonical -> N.Name -> Constraint -> IO Constraint

101+letSub :: ModuleName.Canonical -> Name.Name -> Constraint -> IO Constraint

102102letSub home tipe constraint =

103103 do msgVar <- mkFlexVar

104104 let msg = VarN msgVar

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

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

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

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

108108

@@ -155,22 +155,22 @@ constrainEffects home r0 r1 r2 manager =

155155 checkMap "subMap" home sub CSaveTheEnvironment

156156

157157

158−effectList :: ModuleName.Canonical -> N.Name -> Type -> Type

158+effectList :: ModuleName.Canonical -> Name.Name -> Type -> Type

159159effectList home name msg =

160− AppN ModuleName.list N.list [AppN home name [msg]]

160+ AppN ModuleName.list Name.list [AppN home name [msg]]

161161

162162

163163task :: Type -> Type

164164task answer =

165− AppN ModuleName.platform N.task [ never, answer ]

165+ AppN ModuleName.platform Name.task [ never, answer ]

166166

167167

168168router :: Type -> Type -> Type

169169router msg self =

170− AppN ModuleName.platform N.router [ msg, self ]

170+ AppN ModuleName.platform Name.router [ msg, self ]

171171

172172

173−checkMap :: N.Name -> ModuleName.Canonical -> N.Name -> Constraint -> IO Constraint

173+checkMap :: Name.Name -> ModuleName.Canonical -> Name.Name -> Constraint -> IO Constraint

174174checkMap name home tipe constraint =

175175 do a <- mkFlexVar

176176 b <- mkFlexVar

@@ -179,6 +179,6 @@ checkMap name home tipe constraint =

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

180180

181181

182−toMapType :: ModuleName.Canonical -> N.Name -> Type -> Type -> Type

182+toMapType :: ModuleName.Canonical -> Name.Name -> Type -> Type -> Type

183183toMapType home tipe a b =

184184 (a ==> b) ==> AppN home tipe [a] ==> AppN home tipe [b]

compiler/src/Type/Constrain/Pattern.hs+7−7

@@ -10,11 +10,11 @@ module Type.Constrain.Pattern

1010import Control.Arrow (second)

1111import Control.Monad (foldM)

1212import qualified Data.Map.Strict as Map

13+import qualified Data.Name as Name

1314

1415import qualified AST.Canonical as Can

1516import qualified AST.Module.Name as ModuleName

1617import qualified Data.Index as Index

17−import qualified Elm.Name as N

1818import qualified Reporting.Annotation as A

1919import qualified Reporting.Error.Type as E

2020import qualified Reporting.Region as R

@@ -37,7 +37,7 @@ data State =

3737 }

3838

3939

40−type Header = Map.Map N.Name (A.Located Type)

40+type Header = Map.Map Name.Name (A.Located Type)

4141

4242

4343add :: Can.Pattern -> E.PExpected Type -> State -> IO State

@@ -67,7 +67,7 @@ add (A.At region pattern) expectation state =

6767 Can.PList patterns ->

6868 do entryVar <- mkFlexVar

6969 let entryType = VarN entryVar

70− let listType = AppN ModuleName.list N.list [entryType]

70+ let listType = AppN ModuleName.list Name.list [entryType]

7171

7272 (State headers vars revCons) <-

7373 foldM (addEntry region entryType) state (Index.indexedMap (,) patterns)

@@ -78,7 +78,7 @@ add (A.At region pattern) expectation state =

7878 Can.PCons headPattern tailPattern ->

7979 do entryVar <- mkFlexVar

8080 let entryType = VarN entryVar

81− let listType = AppN ModuleName.list N.list [entryType]

81+ let listType = AppN ModuleName.list Name.list [entryType]

8282

8383 let headExpectation = E.PNoExpectation entryType

8484 let tailExpectation = E.PFromContext region E.PTail listType

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

138138 State Map.empty [] []

139139

140140

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

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

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

143143 let

144144 tipe = getType expectation

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

211211-- CONSTRAIN CONSTRUCTORS

212212

213213

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

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

215215addCtor region home typeName typeVarNames ctorName args expectation state =

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

217217 let typePairs = map (second VarN) varPairs

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

231231 }

232232

233233

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

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

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

236236 do tipe <- Instantiate.fromSrcType freeVarDict srcType

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

compiler/src/Type/Error.hs+34−34

@@ -21,10 +21,10 @@ module Type.Error

2121import qualified Data.Map as Map

2222import qualified Data.Maybe as Maybe

2323import Data.Monoid ((<>))

24+import qualified Data.Name as Name

2425

2526import qualified AST.Module.Name as ModuleName

2627import qualified Data.Bag as Bag

27−import qualified Elm.Name as N

2828import qualified Reporting.Doc as D

2929import qualified Reporting.Render.Type as RT

3030import qualified Reporting.Render.Type.Localizer as L

@@ -38,15 +38,15 @@ data Type

3838 = Lambda Type Type [Type]

3939 | Infinite

4040 | Error

41− | FlexVar N.Name

42− | FlexSuper Super N.Name

43− | RigidVar N.Name

44− | RigidSuper Super N.Name

45− | Type ModuleName.Canonical N.Name [Type]

46− | Record (Map.Map N.Name Type) Extension

41+ | FlexVar Name.Name

42+ | FlexSuper Super Name.Name

43+ | RigidVar Name.Name

44+ | RigidSuper Super Name.Name

45+ | Type ModuleName.Canonical Name.Name [Type]

46+ | Record (Map.Map Name.Name Type) Extension

4747 | Unit

4848 | Tuple Type Type (Maybe Type)

49− | Alias ModuleName.Canonical N.Name [(N.Name, Type)] Type

49+ | Alias ModuleName.Canonical Name.Name [(Name.Name, Type)] Type

5050

5151

5252data Super

@@ -59,8 +59,8 @@ data Super

5959

6060data Extension

6161 = Closed

62− | FlexOpen N.Name

63− | RigidOpen N.Name

62+ | FlexOpen Name.Name

63+ | RigidOpen Name.Name

6464

6565

6666iteratedDealias :: Type -> Type

@@ -125,19 +125,19 @@ toDoc localizer ctx tipe =

125125 aliasToDoc localizer ctx home name args

126126

127127

128−aliasToDoc :: L.Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> [(N.Name, Type)] -> D.Doc

128+aliasToDoc :: L.Localizer -> RT.Context -> ModuleName.Canonical -> Name.Name -> [(Name.Name, Type)] -> D.Doc

129129aliasToDoc localizer ctx home name args =

130130 RT.apply ctx

131131 (L.toDoc localizer home name)

132132 (map (toDoc localizer RT.App . snd) args)

133133

134134

135−fieldsToDocs :: L.Localizer -> Map.Map N.Name Type -> [(D.Doc, D.Doc)]

135+fieldsToDocs :: L.Localizer -> Map.Map Name.Name Type -> [(D.Doc, D.Doc)]

136136fieldsToDocs localizer fields =

137137 Map.foldrWithKey (addField localizer) [] fields

138138

139139

140−addField :: L.Localizer -> N.Name -> Type -> [(D.Doc, D.Doc)] -> [(D.Doc, D.Doc)]

140+addField :: L.Localizer -> Name.Name -> Type -> [(D.Doc, D.Doc)] -> [(D.Doc, D.Doc)]

141141addField localizer fieldName fieldType docs =

142142 let

143143 f = D.fromName fieldName

@@ -178,11 +178,11 @@ data Problem

178178 | AnythingToList

179179 | MissingArgs Int

180180 | ReturnMismatch

181− | BadFlexSuper Direction Super N.Name Type

182− | BadRigidVar N.Name Type

183− | BadRigidSuper Super N.Name Type

184− | FieldTypo N.Name [N.Name]

185− | FieldsMissing [N.Name]

181+ | BadFlexSuper Direction Super Name.Name Type

182+ | BadRigidVar Name.Name Type

183+ | BadRigidSuper Super Name.Name Type

184+ | FieldTypo Name.Name [Name.Name]

185+ | FieldsMissing [Name.Name]

186186

187187

188188data Direction = Have | Need

@@ -398,39 +398,39 @@ isSimilar (Diff _ _ status) =

398398-- IS TYPE?

399399

400400

401−isBool :: ModuleName.Canonical -> N.Name -> Bool

401+isBool :: ModuleName.Canonical -> Name.Name -> Bool

402402isBool home name =

403− home == ModuleName.basics && name == N.bool

403+ home == ModuleName.basics && name == Name.bool

404404

405405

406−isInt :: ModuleName.Canonical -> N.Name -> Bool

406+isInt :: ModuleName.Canonical -> Name.Name -> Bool

407407isInt home name =

408− home == ModuleName.basics && name == N.int

408+ home == ModuleName.basics && name == Name.int

409409

410410

411−isFloat :: ModuleName.Canonical -> N.Name -> Bool

411+isFloat :: ModuleName.Canonical -> Name.Name -> Bool

412412isFloat home name =

413− home == ModuleName.basics && name == N.float

413+ home == ModuleName.basics && name == Name.float

414414

415415

416−isString :: ModuleName.Canonical -> N.Name -> Bool

416+isString :: ModuleName.Canonical -> Name.Name -> Bool

417417isString home name =

418− home == ModuleName.string && name == N.string

418+ home == ModuleName.string && name == Name.string

419419

420420

421−isChar :: ModuleName.Canonical -> N.Name -> Bool

421+isChar :: ModuleName.Canonical -> Name.Name -> Bool

422422isChar home name =

423− home == ModuleName.char && name == N.char

423+ home == ModuleName.char && name == Name.char

424424

425425

426−isMaybe :: ModuleName.Canonical -> N.Name -> Bool

426+isMaybe :: ModuleName.Canonical -> Name.Name -> Bool

427427isMaybe home name =

428− home == ModuleName.maybe && name == N.maybe

428+ home == ModuleName.maybe && name == Name.maybe

429429

430430

431−isList :: ModuleName.Canonical -> N.Name -> Bool

431+isList :: ModuleName.Canonical -> Name.Name -> Bool

432432isList home name =

433− home == ModuleName.list && name == N.list

433+ home == ModuleName.list && name == Name.list

434434

435435

436436

@@ -455,7 +455,7 @@ isSuper super tipe =

455455-- NAME CLASH

456456

457457

458−nameClashToDoc :: RT.Context -> L.Localizer -> ModuleName.Canonical -> N.Name -> [Type] -> D.Doc

458+nameClashToDoc :: RT.Context -> L.Localizer -> ModuleName.Canonical -> Name.Name -> [Type] -> D.Doc

459459nameClashToDoc ctx localizer (ModuleName.Canonical _ home) name args =

460460 RT.apply ctx

461461 (D.yellow (D.fromName home) <> D.dullyellow ("." <> D.fromName name))

@@ -598,7 +598,7 @@ toGreedyMatchHelp localizer shorterArgs longerArgs match@(GreedyMatch shorterDoc

598598-- RECORD DIFFS

599599

600600

601−diffRecord :: L.Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc

601+diffRecord :: L.Localizer -> Map.Map Name.Name Type -> Extension -> Map.Map Name.Name Type -> Extension -> Diff D.Doc

602602diffRecord localizer fields1 ext1 fields2 ext2 =

603603 let

604604 toUnknownDocs field tipe =

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

@@ -9,9 +9,9 @@ module Type.Instantiate

1010import qualified Data.Map.Strict as Map

1111import Data.Map.Strict ((!))

12+import qualified Data.Name as Name

1213

1314import qualified AST.Canonical as Can

14−import qualified Elm.Name as N

1515import Type.Type

1616

1717

@@ -20,14 +20,14 @@ import Type.Type

2020

2121

2222type FreeVars =

23− Map.Map N.Name Type

23+ Map.Map Name.Name Type

2424

2525

2626

2727-- FROM SOURCE TYPE

2828

2929

30−fromSrcType :: Map.Map N.Name Type -> Can.Type -> IO Type

30+fromSrcType :: Map.Map Name.Name Type -> Can.Type -> IO Type

3131fromSrcType freeVars sourceType =

3232 case sourceType of

3333 Can.TLambda arg result ->

@@ -72,6 +72,6 @@ fromSrcType freeVars sourceType =

7272 return (freeVars ! ext)

7373

7474

75−fromSrcFieldType :: Map.Map N.Name Type -> Can.FieldType -> IO Type

75+fromSrcFieldType :: Map.Map Name.Name Type -> Can.FieldType -> IO Type

7676fromSrcFieldType freeVars (Can.FieldType _ tipe) =

7777 fromSrcType freeVars tipe

compiler/src/Type/Solve.hs+13−13

@@ -9,11 +9,11 @@ module Type.Solve

99import Control.Monad

1010import qualified Data.Map.Strict as Map

1111import Data.Map.Strict ((!))

12+import qualified Data.Name as Name

1213import qualified Data.Vector as Vector

1314import qualified Data.Vector.Mutable as MVector

1415

1516import qualified AST.Canonical as Can

16−import qualified Elm.Name as N

1717import qualified Reporting.Annotation as A

1818import qualified Reporting.Error.Type as Error

1919import qualified Reporting.Render.Type as RT

@@ -29,7 +29,7 @@ import qualified Type.UnionFind as UF

2929-- RUN SOLVER

3030

3131

32−run :: Constraint -> IO (Either [Error.Error] (Map.Map N.Name Can.Annotation))

32+run :: Constraint -> IO (Either [Error.Error] (Map.Map Name.Name Can.Annotation))

3333run constraint =

3434 do pools <- MVector.replicate 8 []

3535

@@ -56,7 +56,7 @@ emptyState =

5656

5757

5858type Env =

59− Map.Map N.Name Variable

59+ Map.Map Name.Name Variable

6060

6161

6262type Pools =

@@ -252,7 +252,7 @@ addError (State savedEnv rank errors) err =

252252-- OCCURS CHECK

253253

254254

255−occurs :: State -> (N.Name, A.Located Variable) -> IO State

255+occurs :: State -> (Name.Name, A.Located Variable) -> IO State

256256occurs state (name, A.At region variable) =

257257 do hasOccurred <- Occurs.occurs variable

258258 if hasOccurred

@@ -426,7 +426,7 @@ typeToVariable rank pools tipe =

426426 typeToVar rank pools Map.empty tipe

427427

428428

429−typeToVar :: Int -> Pools -> Map.Map N.Name Variable -> Type -> IO Variable

429+typeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Type -> IO Variable

430430typeToVar rank pools aliasDict tipe =

431431 let go = typeToVar rank pools aliasDict in

432432 case tipe of

@@ -491,15 +491,15 @@ unit1 =

491491-- SOURCE TYPE TO VARIABLE

492492

493493

494−srcTypeToVariable :: Int -> Pools -> Map.Map N.Name () -> Can.Type -> IO Variable

494+srcTypeToVariable :: Int -> Pools -> Map.Map Name.Name () -> Can.Type -> IO Variable

495495srcTypeToVariable rank pools freeVars srcType =

496496 let

497497 nameToContent name

498− | N.startsWith "number" name = FlexSuper Number (Just name)

499− | N.startsWith "comparable" name = FlexSuper Comparable (Just name)

500− | N.startsWith "appendable" name = FlexSuper Appendable (Just name)

501− | N.startsWith "compappend" name = FlexSuper CompAppend (Just name)

502− | otherwise = FlexVar (Just name)

498+ | Name.isNumberType name = FlexSuper Number (Just name)

499+ | Name.isComparableType name = FlexSuper Comparable (Just name)

500+ | Name.isAppendableType name = FlexSuper Appendable (Just name)

501+ | Name.isCompappendType name = FlexSuper CompAppend (Just name)

502+ | otherwise = FlexVar (Just name)

503503

504504 makeVar name _ =

505505 UF.fresh (Descriptor (nameToContent name) rank noMark Nothing)

@@ -509,7 +509,7 @@ srcTypeToVariable rank pools freeVars srcType =

509509 srcTypeToVar rank pools flexVars srcType

510510

511511

512−srcTypeToVar :: Int -> Pools -> Map.Map N.Name Variable -> Can.Type -> IO Variable

512+srcTypeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Can.Type -> IO Variable

513513srcTypeToVar rank pools flexVars srcType =

514514 let go = srcTypeToVar rank pools flexVars in

515515 case srcType of

@@ -555,7 +555,7 @@ srcTypeToVar rank pools flexVars srcType =

555555 register rank pools (Alias home name argVars aliasVar)

556556

557557

558−srcFieldTypeToVar :: Int -> Pools -> Map.Map N.Name Variable -> Can.FieldType -> IO Variable

558+srcFieldTypeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Can.FieldType -> IO Variable

559559srcFieldTypeToVar rank pools flexVars (Can.FieldType _ srcTipe) =

560560 srcTypeToVar rank pools flexVars srcTipe

561561

compiler/src/Type/Type.hs+39−45

@@ -33,12 +33,12 @@ import Control.Monad.State.Strict (StateT, liftIO)

3333import qualified Control.Monad.State.Strict as State

3434import Data.Foldable (foldrM)

3535import qualified Data.Map.Strict as Map

36+import qualified Data.Name as Name

3637import Data.Word (Word32)

3738

3839import qualified AST.Canonical as Can

3940import qualified AST.Module.Name as ModuleName

4041import qualified AST.Utils.Type as Type

41−import qualified Elm.Name as N

4242import qualified Reporting.Annotation as A

4343import qualified Reporting.Error.Type as E

4444import qualified Reporting.Region as R

@@ -54,14 +54,14 @@ data Constraint

5454 = CTrue

5555 | CSaveTheEnvironment

5656 | CEqual R.Region E.Category Type (E.Expected Type)

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

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

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

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

5959 | CPattern R.Region E.PCategory Type (E.PExpected Type)

6060 | CAnd [Constraint]

6161 | CLet

6262 { _rigidVars :: [Variable]

6363 , _flexVars :: [Variable]

64− , _header :: Map.Map N.Name (A.Located Type)

64+ , _header :: Map.Map Name.Name (A.Located Type)

6565 , _headerCon :: Constraint

6666 , _bodyCon :: Constraint

6767 }

@@ -81,22 +81,22 @@ type Variable =

8181

8282

8383data FlatType

84− = App1 ModuleName.Canonical N.Name [Variable]

84+ = App1 ModuleName.Canonical Name.Name [Variable]

8585 | Fun1 Variable Variable

8686 | EmptyRecord1

87− | Record1 (Map.Map N.Name Variable) Variable

87+ | Record1 (Map.Map Name.Name Variable) Variable

8888 | Unit1

8989 | Tuple1 Variable Variable (Maybe Variable)

9090

9191

9292data Type

93− = PlaceHolder N.Name

94− | AliasN ModuleName.Canonical N.Name [(N.Name, Type)] Type

93+ = PlaceHolder Name.Name

94+ | AliasN ModuleName.Canonical Name.Name [(Name.Name, Type)] Type

9595 | VarN Variable

96− | AppN ModuleName.Canonical N.Name [Type]

96+ | AppN ModuleName.Canonical Name.Name [Type]

9797 | FunN Type Type

9898 | EmptyRecordN

99− | RecordN (Map.Map N.Name Type) Type

99+ | RecordN (Map.Map Name.Name Type) Type

100100 | UnitN

101101 | TupleN Type Type (Maybe Type)

102102

@@ -115,12 +115,12 @@ data Descriptor =

115115

116116

117117data Content

118− = FlexVar (Maybe N.Name)

119− | FlexSuper SuperType (Maybe N.Name)

120− | RigidVar N.Name

121− | RigidSuper SuperType N.Name

118+ = FlexVar (Maybe Name.Name)

119+ | FlexSuper SuperType (Maybe Name.Name)

120+ | RigidVar Name.Name

121+ | RigidSuper SuperType Name.Name

122122 | Structure FlatType

123− | Alias ModuleName.Canonical N.Name [(N.Name,Variable)] Variable

123+ | Alias ModuleName.Canonical Name.Name [(Name.Name,Variable)] Variable

124124 | Error

125125

126126

@@ -301,30 +301,30 @@ unnamedFlexSuper super =

301301-- MAKE NAMED VARIABLES

302302

303303

304−nameToFlex :: N.Name -> IO Variable

304+nameToFlex :: Name.Name -> IO Variable

305305nameToFlex name =

306306 UF.fresh $ makeDescriptor $

307307 maybe FlexVar FlexSuper (toSuper name) (Just name)

308308

309309

310−nameToRigid :: N.Name -> IO Variable

310+nameToRigid :: Name.Name -> IO Variable

311311nameToRigid name =

312312 UF.fresh $ makeDescriptor $

313313 maybe RigidVar RigidSuper (toSuper name) name

314314

315315

316−toSuper :: N.Name -> Maybe SuperType

316+toSuper :: Name.Name -> Maybe SuperType

317317toSuper name =

318− if N.startsWith "number" name then

318+ if Name.isNumberType name then

319319 Just Number

320320

321− else if N.startsWith "comparable" name then

321+ else if Name.isComparableType name then

322322 Just Comparable

323323

324− else if N.startsWith "appendable" name then

324+ else if Name.isAppendableType name then

325325 Just Appendable

326326

327− else if N.startsWith "compappend" name then

327+ else if Name.isCompappendType name then

328328 Just CompAppend

329329

330330 else

@@ -557,7 +557,7 @@ termToErrorType term =

557557

558558data NameState =

559559 NameState

560− { _taken :: Map.Map N.Name ()

560+ { _taken :: Map.Map Name.Name ()

561561 , _normals :: Int

562562 , _numbers :: Int

563563 , _comparables :: Int

@@ -566,7 +566,7 @@ data NameState =

566566 }

567567

568568

569−makeNameState :: Map.Map N.Name Variable -> NameState

569+makeNameState :: Map.Map Name.Name Variable -> NameState

570570makeNameState taken =

571571 NameState (Map.map (const ()) taken) 0 0 0 0 0

572572

@@ -575,7 +575,7 @@ makeNameState taken =

575575-- FRESH VAR NAMES

576576

577577

578−getFreshVarName :: (Monad m) => StateT NameState m N.Name

578+getFreshVarName :: (Monad m) => StateT NameState m Name.Name

579579getFreshVarName =

580580 do index <- State.gets _normals

581581 taken <- State.gets _taken

@@ -584,26 +584,23 @@ getFreshVarName =

584584 return name

585585

586586

587−getFreshVarNameHelp :: Int -> Map.Map N.Name () -> (N.Name, Int, Map.Map N.Name ())

587+getFreshVarNameHelp :: Int -> Map.Map Name.Name () -> (Name.Name, Int, Map.Map Name.Name ())

588588getFreshVarNameHelp index taken =

589589 let

590− (postfix, letter) =

591− quotRem index 26

592−

593− chr = N.fromLetter letter

594− name = if postfix <= 0 then chr else N.addIndex chr postfix

590+ name =

591+ Name.fromTypeVariableScheme index

595592 in

596− if Map.member name taken then

597− getFreshVarNameHelp (index + 1) taken

598− else

599− ( name, index + 1, Map.insert name () taken )

593+ if Map.member name taken then

594+ getFreshVarNameHelp (index + 1) taken

595+ else

596+ ( name, index + 1, Map.insert name () taken )

600597

601598

602599

603600-- FRESH SUPER NAMES

604601

605602

606−getFreshSuperName :: (Monad m) => SuperType -> StateT NameState m N.Name

603+getFreshSuperName :: (Monad m) => SuperType -> StateT NameState m Name.Name

607604getFreshSuperName super =

608605 case super of

609606 Number ->

@@ -619,7 +616,7 @@ getFreshSuperName super =

619616 getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })

620617

621618

622−getFreshSuper :: (Monad m) => N.Name -> (NameState -> Int) -> (Int -> NameState -> NameState) -> StateT NameState m N.Name

619+getFreshSuper :: (Monad m) => Name.Name -> (NameState -> Int) -> (Int -> NameState -> NameState) -> StateT NameState m Name.Name

623620getFreshSuper prefix getter setter =

624621 do index <- State.gets getter

625622 taken <- State.gets _taken

@@ -628,11 +625,11 @@ getFreshSuper prefix getter setter =

628625 return name

629626

630627

631−getFreshSuperHelp :: N.Name -> Int -> Map.Map N.Name () -> (N.Name, Int, Map.Map N.Name ())

628+getFreshSuperHelp :: Name.Name -> Int -> Map.Map Name.Name () -> (Name.Name, Int, Map.Map Name.Name ())

632629getFreshSuperHelp prefix index taken =

633630 let

634631 name =

635− if index <= 0 then prefix else N.addIndex prefix index

632+ Name.fromTypeVariable prefix index

636633 in

637634 if Map.member name taken then

638635 getFreshSuperHelp prefix (index + 1) taken

@@ -645,7 +642,7 @@ getFreshSuperHelp prefix index taken =

645642-- GET ALL VARIABLE NAMES

646643

647644

648−getVarNames :: Variable -> Map.Map N.Name Variable -> IO (Map.Map N.Name Variable)

645+getVarNames :: Variable -> Map.Map Name.Name Variable -> IO (Map.Map Name.Name Variable)

649646getVarNames var takenNames =

650647 do (Descriptor content rank mark copy) <- UF.get var

651648 if mark == getVarNamesMark

@@ -710,14 +707,11 @@ getVarNames var takenNames =

710707-- REGISTER NAME / RENAME DUPLICATES

711708

712709

713−addName :: Int -> N.Name -> Variable -> (N.Name -> Content) -> Map.Map N.Name Variable -> IO (Map.Map N.Name Variable)

710+addName :: Int -> Name.Name -> Variable -> (Name.Name -> Content) -> Map.Map Name.Name Variable -> IO (Map.Map Name.Name Variable)

714711addName index givenName var makeContent takenNames =

715712 let

716713 indexedName =

717− if index <= 0 then

718− givenName

719− else

720− N.addSafeIndex givenName index

714+ Name.fromTypeVariable givenName index

721715 in

722716 case Map.lookup indexedName takenNames of

723717 Nothing ->

compiler/src/Type/Unify.hs+11−11

@@ -8,9 +8,9 @@ module Type.Unify

1010import qualified Data.Map.Strict as Map

11+import qualified Data.Name as Name

1112

1213import qualified AST.Module.Name as ModuleName

13−import qualified Elm.Name as N

1414import qualified Type.Error as Error

1515import qualified Type.Occurs as Occurs

1616import Type.Type as Type

@@ -342,7 +342,7 @@ combineRigidSupers rigid flex =

342342 || (rigid == CompAppend && (flex == Comparable || flex == Appendable))

343343

344344

345−atomMatchesSuper :: SuperType -> ModuleName.Canonical -> N.Name -> Bool

345+atomMatchesSuper :: SuperType -> ModuleName.Canonical -> Name.Name -> Bool

346346atomMatchesSuper super home name =

347347 case super of

348348 Number ->

@@ -360,11 +360,11 @@ atomMatchesSuper super home name =

360360 Error.isString home name

361361

362362

363−isNumber :: ModuleName.Canonical -> N.Name -> Bool

363+isNumber :: ModuleName.Canonical -> Name.Name -> Bool

364364isNumber home name =

365365 home == ModuleName.basics

366366 &&

367− (name == N.int || name == N.float)

367+ (name == Name.int || name == Name.float)

368368

369369

370370unifyFlexSuperStructure :: Context -> SuperType -> FlatType -> Unify ()

@@ -376,7 +376,7 @@ unifyFlexSuperStructure context super flatType =

376376 else

377377 mismatch

378378

379− App1 home name [variable] | home == ModuleName.list && name == N.list ->

379+ App1 home name [variable] | home == ModuleName.list && name == Name.list ->

380380 case super of

381381 Number ->

382382 mismatch

@@ -444,7 +444,7 @@ unifyComparableRecursive var =

444444-- UNIFY ALIASES

445445

446446

447−unifyAlias :: Context -> ModuleName.Canonical -> N.Name -> [(N.Name, Variable)] -> Variable -> Content -> Unify ()

447+unifyAlias :: Context -> ModuleName.Canonical -> Name.Name -> [(Name.Name, Variable)] -> Variable -> Content -> Unify ()

448448unifyAlias context home name args realVar otherContent =

449449 case otherContent of

450450 FlexVar _ ->

@@ -480,7 +480,7 @@ unifyAlias context home name args realVar otherContent =

480480 merge context Error

481481

482482

483−unifyAliasArgs :: [Variable] -> Context -> [(N.Name,Variable)] -> [(N.Name,Variable)] -> ([Variable] -> () -> IO r) -> ([Variable] -> () -> IO r) -> IO r

483+unifyAliasArgs :: [Variable] -> Context -> [(Name.Name,Variable)] -> [(Name.Name,Variable)] -> ([Variable] -> () -> IO r) -> ([Variable] -> () -> IO r) -> IO r

484484unifyAliasArgs vars context args1 args2 ok err =

485485 case args1 of

486486 (_,arg1):others1 ->

@@ -648,7 +648,7 @@ unifyRecord context (RecordStructure fields1 ext1) (RecordStructure fields2 ext2

648648 unifySharedFields context sharedFields otherFields ext

649649

650650

651−unifySharedFields :: Context -> Map.Map N.Name (Variable, Variable) -> Map.Map N.Name Variable -> Variable -> Unify ()

651+unifySharedFields :: Context -> Map.Map Name.Name (Variable, Variable) -> Map.Map Name.Name Variable -> Variable -> Unify ()

652652unifySharedFields context sharedFields otherFields ext =

653653 do matchingFields <- Map.traverseMaybeWithKey unifyField sharedFields

654654 if Map.size sharedFields == Map.size matchingFields

@@ -656,7 +656,7 @@ unifySharedFields context sharedFields otherFields ext =

656656 else mismatch

657657

658658

659−unifyField :: N.Name -> (Variable, Variable) -> Unify (Maybe Variable)

659+unifyField :: Name.Name -> (Variable, Variable) -> Unify (Maybe Variable)

660660unifyField _ (actual, expected) =

661661 Unify $ \vars ok _ ->

662662 case subUnify actual expected of

@@ -672,12 +672,12 @@ unifyField _ (actual, expected) =

672672

673673data RecordStructure =

674674 RecordStructure

675− { _fields :: Map.Map N.Name Variable

675+ { _fields :: Map.Map Name.Name Variable

676676 , _extension :: Variable

677677 }

678678

679679

680−gatherFields :: Map.Map N.Name Variable -> Variable -> IO RecordStructure

680+gatherFields :: Map.Map Name.Name Variable -> Variable -> IO RecordStructure

681681gatherFields fields variable =

682682 do (Descriptor content _ _ _) <- UF.get variable

683683 case content of