git.iko.soy/elk
on master help sign in
Merge branch 'master' of https://github.com/elm-lang/elm-compiler into sortingRefGraph
commitc6bde912989ad6a25a239c5767888c4135a526e8 authorJoeyEremondi <joey@eremondi.com> dateFri 28 Aug 2015, 16:52 (11 years ago) parent8a43c4099243c2
24 files changed+364−340
compare with master
unifiedsplit
elm-compiler.cabal+1 src/AST/Module.hs+17−30 src/AST/Module/Name.hs+50 src/AST/Variable.hs+16−11 src/Canonicalize.hs+17−8 src/Canonicalize/Declaration.hs+3−3 src/Canonicalize/Environment.hs+3−3 src/Canonicalize/Result.hs+4−4 src/Canonicalize/Setup.hs+39−31 src/Canonicalize/Variable.hs+11−11 src/Compile.hs+5−8 src/Elm/Compiler.hs+11−10 src/Elm/Compiler/Module.hs+7−2 src/Elm/Package.hs+17−15 src/Generate/JavaScript.hs+7−107 src/Generate/JavaScript/Variable.hs+37−20 src/Nitpick/PatternMatches.hs+3−2 src/Nitpick/TopLevelTypes.hs+49−29 src/Parse/Module.hs+8−4 src/Parse/Parse.hs+19−10 src/Reporting/Error/Canonicalize.hs+8−8 src/Reporting/Warning.hs+3−3 src/Type/Inference.hs+28−20 tests/Test/Compiler.hs+1−1
elm-compiler.cabal+1
@@ -56,6 +56,7 @@ Library
5656 AST.Helpers,
5757 AST.Literal,
5858 AST.Module,
59+ AST.Module.Name,
5960 AST.Pattern,
6061 AST.Type,
6162 AST.Variable,
src/AST/Module.hs+17−30
@@ -5,19 +5,18 @@ module AST.Module
55 , SourceModule, ValidModule, CanonicalModule, Optimized
66 , Module(..), Body(..)
77 , Header(..)
8− , Name, nameToString, nameIsNative
98 , Interface(..), toInterface
109 , UserImport, DefaultImport, ImportMethod(..)
1110 ) where
1211
1312import Control.Applicative ((<$>),(<*>))
1413import Data.Binary
15−import qualified Data.List as List
1614import qualified Data.Map as Map
1715
1816import qualified AST.Declaration as Decl
1917import qualified AST.Expression.Canonical as Canonical
2018import qualified AST.Expression.Optimized as Optimized
19+import qualified AST.Module.Name as Name
2120import qualified AST.Type as Type
2221import qualified AST.Variable as Var
2322import qualified Docs.AST as Docs
@@ -28,7 +27,7 @@ import qualified Reporting.Annotation as A
2827
2928-- HELPFUL TYPE ALIASES
3029
31−type Interfaces = Map.Map Name Interface
30+type Interfaces = Map.Map Name.Canonical Interface
3231
3332type Types = Map.Map String Type.Canonical
3433type Aliases = Map.Map String ([String], Type.Canonical)
@@ -57,15 +56,15 @@ type ValidModule =
5756
5857
5958type CanonicalModule =
60− Module Docs.Centralized [Name] [Var.Value] (Body Canonical.Expr)
59+ Module Docs.Centralized [Name.Raw] [Var.Value] (Body Canonical.Expr)
6160
6261
6362type Optimized =
64− Module Docs.Centralized [Name] [Var.Value] (Body Optimized.Expr)
63+ Module Docs.Centralized [Name.Raw] [Var.Value] (Body Optimized.Expr)
6564
6665
6766data Module docs imports exports body = Module
68− { names :: Name
67+ { name :: Name.Canonical
6968 , path :: FilePath
7069 , docs :: A.Located (Maybe docs)
7170 , exports :: exports
@@ -88,34 +87,19 @@ data Body expr = Body
8887
8988{-| Basic info needed to identify modules and determine dependencies. -}
9089data Header imports = Header
91− { _names :: Name
90+ { _name :: Name.Raw
9291 , _docs :: A.Located (Maybe String)
9392 , _exports :: Var.Listing (A.Located Var.Value)
9493 , _imports :: imports
9594 }
9695
9796
98−type Name = [String] -- must be non-empty
99−
100−
101−nameToString :: Name -> String
102−nameToString =
103− List.intercalate "."
104−
105−
106−nameIsNative :: Name -> Bool
107−nameIsNative name =
108− case name of
109− "Native" : _ -> True
110− _ -> False
111−
112−
11397-- IMPORTs
11498
115−type UserImport = A.Located (Name, ImportMethod)
99+type UserImport = A.Located (Name.Raw, ImportMethod)
116100
117101
118−type DefaultImport = (Name, ImportMethod)
102+type DefaultImport = (Name.Raw, ImportMethod)
119103
120104
121105data ImportMethod = ImportMethod
@@ -128,10 +112,11 @@ data ImportMethod = ImportMethod
128112
129113{-| Key facts about a module, used when reading info from .elmi files. -}
130114data Interface = Interface
131− { iVersion :: String
115+ { iVersion :: Package.Version
116+ , iPackage :: Package.Name
132117 , iExports :: [Var.Value]
133118 , iTypes :: Types
134− , iImports :: [Name]
119+ , iImports :: [Name.Raw]
135120 , iAdts :: ADTs
136121 , iAliases :: Aliases
137122 , iFixities :: [(Decl.Assoc, Int, String)]
@@ -139,11 +124,12 @@ data Interface = Interface
139124 }
140125
141126
142−toInterface :: CanonicalModule -> Interface
143−toInterface modul =
127+toInterface :: Package.Name -> CanonicalModule -> Interface
128+toInterface pkgName modul =
144129 let body' = body modul in
145130 Interface
146− { iVersion = Package.versionToString Compiler.version
131+ { iVersion = Compiler.version
132+ , iPackage = pkgName
147133 , iExports = exports modul
148134 , iTypes = types body'
149135 , iImports = imports modul
@@ -155,9 +141,10 @@ toInterface modul =
155141
156142
157143instance Binary Interface where
158− get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
144+ get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
159145 put modul = do
160146 put (iVersion modul)
147+ put (iPackage modul)
161148 put (iExports modul)
162149 put (iTypes modul)
163150 put (iImports modul)
src/AST/Module/Name.hsnew file+50
@@ -0,0 +1,50 @@
1+module AST.Module.Name where
2+
3+import Control.Applicative ((<$>),(<*>))
4+import Data.Binary
5+import qualified Data.List as List
6+
7+import qualified Elm.Package as Package
8+
9+
10+type Raw = [String] -- must be non-empty
11+
12+
13+data Canonical = Canonical
14+ { _package :: Package.Name
15+ , _module :: Raw
16+ }
17+ deriving (Eq, Ord, Show)
18+
19+
20+inCore :: Raw -> Canonical
21+inCore raw =
22+ Canonical Package.coreName raw
23+
24+
25+toString :: Raw -> String
26+toString rawName =
27+ List.intercalate "." rawName
28+
29+
30+canonicalToString :: Canonical -> String
31+canonicalToString (Canonical _ rawName) =
32+ toString rawName
33+
34+
35+isNative :: Raw -> Bool
36+isNative name =
37+ case name of
38+ "Native" : _ ->
39+ True
40+
41+ _ ->
42+ False
43+
44+
45+instance Binary Canonical where
46+ put (Canonical home name) =
47+ put home >> put name
48+
49+ get =
50+ Canonical <$> get <*> get
src/AST/Variable.hs+16−11
@@ -2,12 +2,12 @@ module AST.Variable where
22
33import Control.Applicative ((<$>), (<*>))
44import Data.Binary
5−import qualified Data.List as List
65import qualified Data.Map as Map
76import qualified Data.Maybe as Maybe
87import Text.PrettyPrint as P
98
109import qualified AST.Helpers as Help
10+import qualified AST.Module.Name as ModuleName
1111import qualified Reporting.PrettyPrint as P
1212
1313
@@ -26,8 +26,8 @@ data TopLevelVar =
2626
2727data Home
2828 = BuiltIn
29− | Module [String]
30− | TopLevel [String]
29+ | Module ModuleName.Canonical
30+ | TopLevel ModuleName.Canonical
3131 | Local
3232 deriving (Eq, Ord, Show)
3333
@@ -44,9 +44,9 @@ local x =
4444 Canonical Local x
4545
4646
47−topLevel :: [String] -> String -> Canonical
48−topLevel names x =
49− Canonical (TopLevel names) x
47+topLevel :: ModuleName.Canonical -> String -> Canonical
48+topLevel home x =
49+ Canonical (TopLevel home) x
5050
5151
5252builtin :: String -> Canonical
@@ -54,16 +54,21 @@ builtin x =
5454 Canonical BuiltIn x
5555
5656
57−fromModule :: [String] -> String -> Canonical
57+fromModule :: ModuleName.Canonical -> String -> Canonical
5858fromModule home name =
5959 Canonical (Module home) name
6060
6161
62+inCore :: ModuleName.Raw -> String -> Canonical
63+inCore home name =
64+ Canonical (Module (ModuleName.inCore home)) name
65+
66+
6267-- VARIABLE RECOGNIZERS
6368
64−is :: [String] -> String -> Canonical -> Bool
69+is :: ModuleName.Raw -> String -> Canonical -> Bool
6570is home name var =
66− var == Canonical (Module home) name
71+ var == inCore home name
6772
6873
6974isJson :: Canonical -> Bool
@@ -140,8 +145,8 @@ instance ToString Canonical where
140145 BuiltIn ->
141146 name
142147
143− Module path ->
144− List.intercalate "." (path ++ [name])
148+ Module moduleName ->
149+ ModuleName.canonicalToString moduleName ++ "." ++ name
145150
146151 TopLevel _ ->
147152 name
src/Canonicalize.hs+17−8
@@ -10,12 +10,14 @@ import qualified Data.Foldable as T
1010
1111import AST.Expression.General (Expr'(..), dummyLet)
1212import AST.Module (Body(..))
13+import Elm.Utils ((|>))
1314
1415import qualified AST.Declaration as D
1516import qualified AST.Expression.General as E
1617import qualified AST.Expression.Valid as Valid
1718import qualified AST.Expression.Canonical as Canonical
1819import qualified AST.Module as Module
20+import qualified AST.Module.Name as ModuleName
1921import qualified AST.Pattern as P
2022import qualified AST.Type as Type
2123import qualified AST.Variable as Var
@@ -41,13 +43,19 @@ import qualified Canonicalize.Variable as Canonicalize
4143-- MODULES
4244
4345module'
44− :: Module.Interfaces
46+ :: [ModuleName.Canonical]
47+ -> Module.Interfaces
4548 -> Module.ValidModule
4649 -> R.Result Warning.Warning Error.Error Module.CanonicalModule
47−module' interfaces modul =
50+module' canonicalImports interfaces modul =
4851 let
52+ importDict =
53+ canonicalImports
54+ |> map (\cName -> (ModuleName._module cName, cName))
55+ |> Map.fromList
56+
4957 (Result.Result uses rawResults) =
50− moduleHelp interfaces modul
58+ moduleHelp importDict interfaces modul
5159 in
5260 case rawResults of
5361 Result.Ok (env, almostCanonicalModule) ->
@@ -67,10 +75,11 @@ type AlmostCanonicalModule =
6775
6876
6977moduleHelp
70− :: Module.Interfaces
78+ :: Map.Map ModuleName.Raw ModuleName.Canonical
79+ -> Module.Interfaces
7180 -> Module.ValidModule
7281 -> Result.ResultErr (Env.Environment, AlmostCanonicalModule)
73−moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =
82+moduleHelp importDict interfaces modul@(Module.Module _ _ comment exports _ decls) =
7483 canonicalModule
7584 <$> canonicalDeclsResult
7685 <*> resolveExports locals exports
@@ -88,7 +97,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =
8897 concatMap declToValue decls
8998
9099 canonicalDeclsResult =
91− Setup.environment interfaces modul
100+ Setup.environment importDict interfaces modul
92101 `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls
93102
94103 body :: [D.CanonicalDecl] -> Module.Body Canonical.Expr
@@ -97,7 +106,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =
97106 in
98107 Module.Body
99108 { program =
100− let expr = Decls.toExpr (Module.names modul) decls
109+ let expr = Decls.toExpr (Module.name modul) decls
101110 in
102111 Sort.definitions (dummyLet expr)
103112
@@ -121,7 +130,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =
121130-- IMPORTS
122131
123132filterImports
124− :: Set.Set Module.Name
133+ :: Set.Set ModuleName.Raw
125134 -> AlmostCanonicalModule
126135 -> R.Result Warning.Warning e Module.CanonicalModule
127136filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) =
src/Canonicalize/Declaration.hs+3−3
@@ -4,7 +4,7 @@ module Canonicalize.Declaration (toExpr) where
44import qualified AST.Declaration as D
55import qualified AST.Expression.General as E
66import qualified AST.Expression.Canonical as Canonical
7−import qualified AST.Module as Module
7+import qualified AST.Module.Name as ModuleName
88import qualified AST.Pattern as P
99import qualified AST.Type as T
1010import qualified AST.Variable as Var
@@ -12,12 +12,12 @@ import qualified Reporting.Annotation as A
1212import qualified Reporting.Region as R
1313
1414
15−toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]
15+toExpr :: ModuleName.Canonical -> [D.CanonicalDecl] -> [Canonical.Def]
1616toExpr moduleName decls =
1717 concatMap (toDefs moduleName) decls
1818
1919
20−toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]
20+toDefs :: ModuleName.Canonical -> D.CanonicalDecl -> [Canonical.Def]
2121toDefs moduleName (A.A (region,_) decl) =
2222 let typeVar = Var.fromModule moduleName
2323
src/Canonicalize/Environment.hs+3−3
@@ -7,7 +7,7 @@ import qualified Data.Maybe as Maybe
77import qualified Data.Set as Set
88
99import AST.Expression.General (saveEnvName)
10−import qualified AST.Module as Module
10+import qualified AST.Module.Name as ModuleName
1111import qualified AST.Pattern as P
1212import qualified AST.Type as Type
1313import qualified AST.Variable as Var
@@ -17,7 +17,7 @@ import Elm.Utils ((|>))
1717-- ENVIRONMENT
1818
1919data Environment = Env
20− { _home :: Module.Name
20+ { _home :: ModuleName.Canonical
2121 , _values :: Dict Var.Canonical
2222 , _adts :: Dict Var.Canonical
2323 , _aliases :: Dict (Var.Canonical, [String], Type.Canonical)
@@ -29,7 +29,7 @@ type Dict a =
2929 Map.Map String (Set.Set a)
3030
3131
32−fromPatches :: Module.Name -> [Patch] -> Environment
32+fromPatches :: ModuleName.Canonical -> [Patch] -> Environment
3333fromPatches moduleName patches =
3434 addPatches
3535 patches
src/Canonicalize/Result.hs+4−4
@@ -6,7 +6,7 @@ import qualified Control.Applicative as A
66import qualified Data.Functor as F
77import qualified Data.Set as Set
88
9−import qualified AST.Module as Module
9+import qualified AST.Module.Name as ModuleName
1010import qualified AST.Variable as Var
1111import qualified Reporting.Annotation as A
1212import qualified Reporting.Error.Canonicalize as Error
@@ -16,7 +16,7 @@ type ResultErr a = Result (A.Located Error.Error) a
1616
1717
1818data Result err a =
19− Result (Set.Set Module.Name) (RawResult err a)
19+ Result (Set.Set ModuleName.Raw) (RawResult err a)
2020
2121
2222data RawResult err a
@@ -95,7 +95,7 @@ instance A.Applicative (Result e) where
9595
9696-- TRACK USES OF IMPORTS
9797
98−addModule :: Module.Name -> Result e a -> Result e a
98+addModule :: ModuleName.Raw -> Result e a -> Result e a
9999addModule home (Result uses result) =
100100 Result (Set.insert home uses) result
101101
@@ -103,7 +103,7 @@ addModule home (Result uses result) =
103103var' :: (a -> Var.Canonical) -> a -> Result e a
104104var' toVar value =
105105 case toVar value of
106− Var.Canonical (Var.Module moduleName) _name ->
106+ Var.Canonical (Var.Module (ModuleName.Canonical _ moduleName)) _name ->
107107 Result (Set.singleton moduleName) (Ok value)
108108
109109 Var.Canonical _ _ ->
src/Canonicalize/Setup.hs+39−31
@@ -11,6 +11,7 @@ import qualified Data.Traversable as Trav
1111import qualified AST.Declaration as D
1212import qualified AST.Expression.Valid as Valid
1313import qualified AST.Module as Module
14+import qualified AST.Module.Name as ModuleName
1415import qualified AST.Pattern as P
1516import qualified AST.Type as Type
1617import qualified AST.Variable as Var
@@ -25,50 +26,57 @@ import qualified Canonicalize.Type as Canonicalize
2526
2627
2728environment
28− :: Module.Interfaces
29+ :: Map.Map ModuleName.Raw ModuleName.Canonical
30+ -> Module.Interfaces
2931 -> Module.ValidModule
3032 -> Result.ResultErr Env.Environment
31−environment interfaces modul@(Module.Module _ _ _ _ (defaults, imports) decls) =
32− let moduleName =
33− Module.names modul
33+environment importDict interfaces (Module.Module name _ _ _ (defaults, imports) decls) =
34+ let
35+ allImports =
36+ imports ++ map (A.A (error "default import not found")) defaults
3437
35− allImports =
36− imports ++ map (A.A (error "default import not found")) defaults
38+ importPatchesResult =
39+ concat <$> Trav.traverse (importPatches importDict interfaces) allImports
3740
38− importPatchesResult =
39− concat <$> Trav.traverse (importPatches interfaces) allImports
41+ (typeAliasNodes, declPatches) =
42+ declarationsToPatches name decls
4043
41− (typeAliasNodes, declPatches) =
42− declarationsToPatches moduleName decls
43−
44− patches =
45− (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult
44+ patches =
45+ (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult
4646 in
47− (Env.fromPatches moduleName <$> patches)
48− `Result.andThen` addTypeAliases moduleName typeAliasNodes
47+ (Env.fromPatches name <$> patches)
48+ `Result.andThen` addTypeAliases name typeAliasNodes
4949
5050
5151-- PATCHES FOR IMPORTS
5252
5353importPatches
54− :: Module.Interfaces
55− -> A.Located (Module.Name, Module.ImportMethod)
54+ :: Map.Map ModuleName.Raw ModuleName.Canonical
55+ -> Module.Interfaces
56+ -> A.Located (ModuleName.Raw, Module.ImportMethod)
5657 -> Result.ResultErr [Env.Patch]
57−importPatches allInterfaces (A.A region (importName, method)) =
58− case restrictToPublicApi <$> Map.lookup importName allInterfaces of
58+importPatches importDict allInterfaces (A.A region (rawImportName, method)) =
59+ let
60+ maybeInterface =
61+ do canonicalName <- Map.lookup rawImportName importDict
62+ interface <- Map.lookup canonicalName allInterfaces
63+ return (canonicalName, restrictToPublicApi interface)
64+ in
65+ case maybeInterface of
5966 Nothing ->
60− if Module.nameIsNative importName then
67+ if ModuleName.isNative rawImportName then
6168 Result.ok []
6269
6370 else
6471 allInterfaces
6572 |> Map.keys
66− |> Error.nearbyNames Module.nameToString importName
67− |> Error.moduleNotFound importName
73+ |> map ModuleName._module
74+ |> Error.nearbyNames ModuleName.toString rawImportName
75+ |> Error.moduleNotFound rawImportName
6876 |> A.A region
6977 |> Result.err
7078
71− Just interface ->
79+ Just (importName, interface) ->
7280 let (Module.ImportMethod maybeAlias listing) =
7381 method
7482
@@ -76,7 +84,7 @@ importPatches allInterfaces (A.A region (importName, method)) =
7684 listing
7785
7886 qualifier =
79− maybe (Module.nameToString importName) id maybeAlias
87+ maybe (ModuleName.toString rawImportName) id maybeAlias
8088
8189 qualifiedPatches =
8290 interfacePatches importName (qualifier ++ ".") interface
@@ -89,7 +97,7 @@ importPatches allInterfaces (A.A region (importName, method)) =
8997 (++) qualifiedPatches <$> unqualifiedPatches
9098
9199
92−interfacePatches :: Module.Name -> String -> Module.Interface -> [Env.Patch]
100+interfacePatches :: ModuleName.Canonical -> String -> Module.Interface -> [Env.Patch]
93101interfacePatches moduleName prefix interface =
94102 let genericPatch mkPatch name value =
95103 mkPatch (prefix ++ name) value
@@ -124,7 +132,7 @@ interfacePatches moduleName prefix interface =
124132
125133valueToPatches
126134 :: R.Region
127− -> Module.Name
135+ -> ModuleName.Canonical
128136 -> Module.Interface
129137 -> Var.Value
130138 -> Result.ResultErr [Env.Patch]
@@ -139,7 +147,7 @@ valueToPatches region moduleName interface value =
139147 Module.iExports interface
140148 |> getNames
141149 |> Error.nearbyNames id x
142− |> Error.valueNotFound moduleName x
150+ |> Error.valueNotFound (ModuleName._module moduleName) x
143151 |> A.A region
144152 |> Result.err
145153 in
@@ -232,7 +240,7 @@ node region name tvars alias =
232240
233241
234242addTypeAliases
235− :: Module.Name
243+ :: ModuleName.Canonical
236244 -> [Node]
237245 -> Env.Environment
238246 -> Result.ResultErr Env.Environment
@@ -244,7 +252,7 @@ addTypeAliases moduleName typeAliasNodes initialEnv =
244252
245253
246254addTypeAlias
247− :: Module.Name
255+ :: ModuleName.Canonical
248256 -> Graph.SCC (R.Region, String, [String], Type.Raw)
249257 -> Env.Environment
250258 -> Result.ResultErr Env.Environment
@@ -272,7 +280,7 @@ addTypeAlias moduleName scc env =
272280-- DECLARATIONS TO PATCHES
273281
274282declarationsToPatches
275− :: Module.Name
283+ :: ModuleName.Canonical
276284 -> [D.ValidDecl]
277285 -> ([Node], [Env.Patch])
278286declarationsToPatches moduleName decls =
@@ -288,7 +296,7 @@ declarationsToPatches moduleName decls =
288296-- _values that are defined as top-level declarations are (Var.TopLevel ...)
289297-- all other _values are local (Var.Local)
290298declToPatches
291− :: Module.Name
299+ :: ModuleName.Canonical
292300 -> D.ValidDecl
293301 -> (Maybe Node, [Env.Patch])
294302declToPatches moduleName (A.A (region,_) decl) =
src/Canonicalize/Variable.hs+11−11
@@ -6,7 +6,7 @@ import qualified Data.Map as Map
66import qualified Data.Set as Set
77
88import qualified AST.Helpers as Help
9−import qualified AST.Module as Module
9+import qualified AST.Module.Name as ModuleName
1010import qualified AST.Type as Type
1111import qualified AST.Variable as Var
1212import qualified Reporting.Annotation as A
@@ -22,8 +22,8 @@ variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canoni
2222variable region env var =
2323 case toVarName var of
2424 Right (name, varName)
25− | Module.nameIsNative name ->
26− Result.var (Var.Canonical (Var.Module name) varName)
25+ | ModuleName.isNative name ->
26+ error "TODO" "Result.var (Var.Canonical (Var.Module name) varName)"
2727
2828 _ ->
2929 case Set.toList `fmap` Map.lookup var (Env._values env) of
@@ -134,7 +134,7 @@ preferLocals' region env extract kind possibilities var =
134134 vars = map (Var.toString . extract) possibleVars
135135
136136
137−isLocal :: [String] -> Var.Canonical -> Bool
137+isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool
138138isLocal contextName (Var.Canonical home _) =
139139 case home of
140140 Var.Local ->
@@ -163,7 +163,7 @@ isTopLevel (Var.Canonical home _) =
163163-- NOT FOUND HELPERS
164164
165165type VarName =
166− Either String (Module.Name, String)
166+ Either String (ModuleName.Raw, String)
167167
168168
169169toVarName :: String -> VarName
@@ -180,9 +180,9 @@ noQualifier name =
180180 Right (_, x) -> x
181181
182182
183−qualifiedToString :: (Module.Name, String) -> String
183+qualifiedToString :: (ModuleName.Raw, String) -> String
184184qualifiedToString (modul, name) =
185− Module.nameToString (modul ++ [name])
185+ ModuleName.toString modul ++ "." ++ name
186186
187187
188188isOp :: VarName -> Bool
@@ -225,16 +225,16 @@ exposedProblem name possibleNames =
225225
226226
227227qualifiedProblem
228− :: Module.Name
228+ :: ModuleName.Raw
229229 -> String
230− -> [(Module.Name, String)]
230+ -> [(ModuleName.Raw, String)]
231231 -> (Error.VarProblem, [String])
232232qualifiedProblem moduleName name allQualified =
233233 let availableModules =
234234 Set.fromList (map fst allQualified)
235235
236236 moduleNameString =
237− Module.nameToString moduleName
237+ ModuleName.toString moduleName
238238 in
239239 case Set.member moduleName availableModules of
240240 True ->
@@ -248,6 +248,6 @@ qualifiedProblem moduleName name allQualified =
248248 False ->
249249 ( Error.UnknownQualifier moduleNameString name
250250 , Set.toList availableModules
251− |> map Module.nameToString
251+ |> map ModuleName.toString
252252 |> Error.nearbyNames id moduleNameString
253253 )
src/Compile.hs+5−8
@@ -3,6 +3,7 @@ module Compile (compile) where
33import qualified Data.Map as Map
44
55import qualified AST.Module as Module
6+import qualified AST.Module.Name as ModuleName
67import qualified Canonicalize
78import Elm.Utils ((|>))
89import qualified Elm.Package as Package
@@ -19,25 +20,21 @@ import qualified Type.Inference as TI
1920compile
2021 :: Package.Name
2122 -> Bool
23+ -> [ModuleName.Canonical]
2224 -> Module.Interfaces
2325 -> String
2426 -> Result.Result Warning.Warning Error.Error Module.CanonicalModule
2527
26−compile packageName isRoot interfaces source =
28+compile packageName isRoot canonicalImports interfaces source =
2729 do
28− -- determine if default imports should be added
29− -- only elm-lang/core is exempt
30− let needsDefaults =
31− not (packageName == Package.coreName)
32−
3330 -- Parse the source code
3431 validModule <-
3532 Result.mapError Error.Syntax $
36− Parse.program needsDefaults isRoot (getOpTable interfaces) source
33+ Parse.program packageName isRoot (getOpTable interfaces) source
3734
3835 -- Canonicalize all variables, pinning down where they came from.
3936 canonicalModule <-
40− Canonicalize.module' interfaces validModule
37+ Canonicalize.module' canonicalImports interfaces validModule
4138
4239 -- Run type inference on the program.
4340 types <-
src/Elm/Compiler.hs+11−10
@@ -50,9 +50,9 @@ parseDependencies sourceCode =
5050 Result.Err msgs ->
5151 Left $ map (Error . A.map Error.Syntax) msgs
5252
53− Result.Ok (Module.Header names _docs _exports imports) ->
53+ Result.Ok (Module.Header name _docs _exports imports) ->
5454 Right
55− ( PublicModule.Name names
55+ ( PublicModule.Name name
5656 , map (PublicModule.Name . fst . A.drop) imports
5757 )
5858
@@ -63,22 +63,19 @@ parseDependencies sourceCode =
6363compile
6464 :: Context
6565 -> String
66− -> Map.Map PublicModule.Name PublicModule.Interface
66+ -> PublicModule.Interfaces
6767 -> (Dealiaser, [Warning], Either [Error] Result)
6868
6969compile context source interfaces =
7070 let
71− (Context packageName isRoot isExposed) =
71+ (Context packageName isRoot isExposed dependencies) =
7272 context
7373
74− unwrappedInterfaces =
75− Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces
76−
7774 (Result.Result (dealiaser, warnings) rawResult) =
78− do modul <- Compile.compile packageName isRoot unwrappedInterfaces source
75+ do modul <- Compile.compile packageName isRoot dependencies interfaces source
7976 docs <- docsGen isExposed modul
8077
81− let interface = Module.toInterface modul
78+ let interface = Module.toInterface packageName modul
8279 let optModule = Optimize.optimize modul
8380 let javascript = JS.generate optModule
8481
@@ -94,6 +91,7 @@ data Context = Context
9491 { _packageName :: Package.Name
9592 , _isRoot :: Bool
9693 , _isExposed :: Bool
94+ , _dependencies :: [PublicModule.Canonical]
9795 }
9896
9997
@@ -116,8 +114,11 @@ docsGen isExposed modul =
116114 getChecked =
117115 Docs.check (Module.exports modul) (Module.docs modul)
118116
117+ name =
118+ PublicModule.Name (PublicModule._module (Module.name modul))
119+
119120 toDocs checked =
120− Docs.fromCheckedDocs (PublicModule.Name (Module.names modul)) checked
121+ Docs.fromCheckedDocs name checked
121122 in
122123 (Just . toDocs) `fmap` Result.mapError Error.Docs getChecked
123124
src/Elm/Compiler/Module.hs+7−2
@@ -1,11 +1,12 @@
11module Elm.Compiler.Module
2− ( Interface, Name(Name)
2+ ( Interface, Interfaces, Name(Name)
33 , nameToPath
44 , nameToString, nameFromString
55 , hyphenate, dehyphenate
66 , defaultImports
77 , interfacePorts
88 , interfaceAliasedTypes
9+ , ModuleName.Canonical(..)
910 )
1011 where
1112
@@ -19,6 +20,7 @@ import qualified Data.Text as Text
1920import System.FilePath ((</>))
2021
2122import qualified AST.Module as Module
23+import qualified AST.Module.Name as ModuleName
2224import qualified Elm.Compiler.Imports as Imports
2325import qualified Elm.Compiler.Type as Type
2426import qualified Elm.Compiler.Type.Extract as Extract
@@ -29,7 +31,10 @@ import qualified Elm.Compiler.Type.Extract as Extract
2931type Interface = Module.Interface
3032
3133
32−newtype Name = Name [String]
34+type Interfaces = Module.Interfaces
35+
36+
37+newtype Name = Name ModuleName.Raw
3338 deriving (Eq, Ord)
3439
3540
src/Elm/Package.hs+17−15
@@ -1,8 +1,6 @@
1−{-# LANGUAGE FlexibleContexts #-}
21module Elm.Package where
32
43import Control.Applicative ((<$>), (<*>))
5−import Control.Monad.Error.Class (MonadError, throwError)
64import Data.Aeson
75import Data.Binary
86import qualified Data.List as List
@@ -12,11 +10,17 @@ import System.FilePath ((</>))
1210import Data.Char (isDigit)
1311import Data.Function (on)
1412
13+
14+-- PACKGE NAMES
15+
1516data Name = Name
1617 { user :: String
1718 , project :: String
1819 }
19− deriving (Eq, Ord)
20+ deriving (Eq, Ord, Show)
21+
22+
23+type Package = (Name, Version)
2024
2125
2226dummyName :: Name
@@ -52,11 +56,6 @@ fromString string =
5256 _ -> Nothing
5357
5458
55−fromString' :: (MonadError String m) => String -> m Name
56−fromString' string =
57− Maybe.maybe (throwError $ errorMsg string) return (fromString string)
58−
59−
6059instance Binary Name where
6160 get = Name <$> get <*> get
6261 put (Name user project) =
@@ -66,10 +65,13 @@ instance Binary Name where
6665
6766instance FromJSON Name where
6867 parseJSON (String text) =
69− let string = T.unpack text in
70− Maybe.maybe (fail $ errorMsg string) return (fromString string)
68+ let
69+ string = T.unpack text
70+ in
71+ Maybe.maybe (fail (errorMsg string)) return (fromString string)
7172
72− parseJSON _ = fail "Project name must be a string."
73+ parseJSON _ =
74+ fail "Project name must be a string."
7375
7476
7577instance ToJSON Name where
@@ -85,12 +87,12 @@ errorMsg string =
8587 ]
8688
8789
88−
90+-- PACKAGE VERSIONS
8991
9092data Version = Version
91− { major :: Int
92− , minor :: Int
93− , patch :: Int
93+ { _major :: Int
94+ , _minor :: Int
95+ , _patch :: Int
9496 }
9597 deriving (Eq, Ord)
9698
src/Generate/JavaScript.hs+7−107
@@ -6,19 +6,16 @@ import Control.Monad.State
66import qualified Data.List as List
77import qualified Data.Map as Map
88import qualified Data.Maybe as Maybe
9−import qualified Data.Set as Set
10−import Language.ECMAScript3.PrettyPrint
119import Language.ECMAScript3.Syntax
1210
13−import AST.Module
1411import AST.Expression.General as Expr
1512import qualified AST.Expression.Optimized as Opt
1613import qualified AST.Helpers as Help
1714import AST.Literal
1815import qualified AST.Module as Module
16+import qualified AST.Module.Name as ModuleName
1917import qualified AST.Pattern as P
2018import qualified AST.Variable as Var
21−import Elm.Utils ((|>))
2219import Generate.JavaScript.Helpers as Help
2320import qualified Generate.JavaScript.Crash as Crash
2421import qualified Generate.JavaScript.Port as Port
@@ -28,20 +25,12 @@ import qualified Reporting.Annotation as A
2825import qualified Reporting.Crash as Crash
2926
3027
31−-- HELPERS
28+generate :: Module.Optimized -> String
29+generate modul =
30+ error "TODO" modul exprToCode
3231
33−internalImports :: Module.Name -> [VarDecl ()]
34−internalImports name =
35− [ varDecl "_N" (obj ["Elm","Native"])
36− , include "_U" "Utils"
37− , include "_L" "List"
38− , varDecl Crash.localModuleName (string (Module.nameToString name))
39− ]
40− where
41− include :: String -> String -> VarDecl ()
42− include alias modul =
43− varDecl alias (Help.make ["_N", modul])
4432
33+-- HELPERS
4534
4635_Utils :: String -> Expression ()
4736_Utils x =
@@ -419,9 +408,6 @@ crushIfsHelp visitedBranches unvisitedBranches finally =
419408 (A.A _ (Literal (Boolean True)), branch) : _ ->
420409 crushIfsHelp visitedBranches [] branch
421410
422− (A.A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), branch) : _ ->
423− crushIfsHelp visitedBranches [] branch
424−
425411 visiting : unvisited ->
426412 crushIfsHelp (visiting : visitedBranches) unvisited finally
427413
@@ -597,92 +583,6 @@ flattenLets defs lexpr@(A.A _ expr) =
597583 _ -> (defs, lexpr)
598584
599585
600−generate :: Module.Optimized -> String
601−generate modul =
602− show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++
603− [ assign ("Elm" : names ++ ["make"]) (function [localRuntime] programStmts) ]
604− where
605− names :: [String]
606− names = Module.names modul
607−
608− thisModule :: Expression ()
609− thisModule = obj (localRuntime : names ++ ["values"])
610−
611− programStmts :: [Statement ()]
612− programStmts =
613− concat
614− [ [ ExprStmt () (string "use strict") ]
615− , setup localRuntime (names ++ ["values"])
616− , [ IfSingleStmt () thisModule (ret thisModule) ]
617− , [ VarDeclStmt () localVars ]
618− , body
619− , [ jsExports ]
620− , [ ret thisModule ]
621− ]
622−
623− localVars :: [VarDecl ()]
624− localVars =
625− varDecl "_op" (ObjectLit () [])
626− : internalImports (Module.names modul)
627− ++ explicitImports
628− where
629− explicitImports :: [VarDecl ()]
630− explicitImports =
631− Module.imports modul
632− |> Set.fromList
633− |> Set.toList
634− |> map jsImport
635−
636− jsImport :: Module.Name -> VarDecl ()
637− jsImport name =
638− varDecl (Var.moduleName name) $
639− obj ("Elm" : name ++ ["make"]) <| ref localRuntime
640−
641− body :: [Statement ()]
642− body =
643− concat (evalState defs 0)
644− where
645− defs =
646− Module.program (Module.body modul)
647− |> flattenLets []
648− |> fst
649− |> mapM defToStatements
650−
651− setup namespace path =
652− map create paths
653− where
654− create name =
655− assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))
656− paths =
657− namespace : path
658− |> List.inits
659− |> init
660− |> drop 2
661−
662− jsExports =
663− assign (localRuntime : names ++ ["values"]) (ObjectLit () exs)
664− where
665− exs = map entry $ "_op" : concatMap extract (exports modul)
666− entry x = (prop x, ref x)
667− extract value =
668− case value of
669− Var.Alias _ -> []
670−
671− Var.Value x
672− | Help.isOp x -> []
673− | otherwise -> [Var.varName x]
674−
675− Var.Union _ (Var.Listing ctors _) ->
676− map Var.varName ctors
677−
678− assign path expr =
679− case path of
680− [x] -> VarDeclStmt () [ varDecl x expr ]
681− _ ->
682− ExprStmt () $
683− AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
684−
685−
686586-- BINARY OPERATORS
687587
688588binop
@@ -753,7 +653,7 @@ backwardApply =
753653
754654inBasics :: String -> Var.Canonical
755655inBasics name =
756− Var.Canonical (Var.Module ["Basics"]) name
656+ Var.inCore ["Basics"] name
757657
758658
759659-- BINARY OPERATOR HELPERS
@@ -764,7 +664,7 @@ makeExpr qualifiedOp@(Var.Canonical home op) =
764664 simpleMake left right =
765665 ref "A2" `call` [ Var.canonical qualifiedOp, left, right ]
766666 in
767− if home == Var.Module ["Basics"] then
667+ if home == Var.Module (ModuleName.inCore ["Basics"]) then
768668 Map.findWithDefault simpleMake op basicOps
769669 else
770670 simpleMake
src/Generate/JavaScript/Variable.hs+37−20
@@ -1,13 +1,15 @@
11module Generate.JavaScript.Variable where
22
3−import qualified AST.Helpers as Help
4−import qualified AST.Module as Module
5−import qualified AST.Variable as Var
63import qualified Data.List as List
74import qualified Data.Set as Set
8−import qualified Generate.JavaScript.Helpers as JS
95import qualified Language.ECMAScript3.Syntax as JS
106
7+import qualified AST.Helpers as Help
8+import qualified AST.Module.Name as ModuleName
9+import qualified AST.Variable as Var
10+import qualified Elm.Package as Pkg
11+import qualified Generate.JavaScript.Helpers as JS
12+
1113
1214swap :: Char -> Char -> Char -> Char
1315swap from to c =
@@ -16,21 +18,36 @@ swap from to c =
1618
1719canonical :: Var.Canonical -> JS.Expression ()
1820canonical (Var.Canonical home name) =
19− case Help.isOp name of
20− True -> JS.BracketRef () (JS.obj (home' ++ ["_op"])) (JS.string name)
21− False -> JS.obj (home' ++ [ varName name ])
22− where
23− home' =
24− case home of
25− Var.Local -> []
26− Var.TopLevel _ -> []
27− Var.BuiltIn -> []
28− Var.Module path -> [ moduleName path ]
21+ if Help.isOp name then
22+ JS.BracketRef () (JS.ref (addRoot home "_op")) (JS.string name)
23+
24+ else
25+ JS.ref (addRoot home (varName name))
26+
27+
28+addRoot :: Var.Home -> String -> String
29+addRoot home name =
30+ case home of
31+ Var.Local ->
32+ name
33+
34+ Var.TopLevel moduleName ->
35+ canonicalName moduleName name
36+
37+ Var.BuiltIn ->
38+ name
39+
40+ Var.Module moduleName ->
41+ canonicalName moduleName name
42+
2943
44+canonicalName :: ModuleName.Canonical -> String -> String
45+canonicalName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
46+ map (swap '-' '_') user
47+ ++ '$' : map (swap '-' '_') project
48+ ++ '$' : List.intercalate "$" moduleName
49+ ++ '$' : name
3050
31−moduleName :: Module.Name -> String
32−moduleName name =
33− '$' : List.intercalate "$" name
3451
3552
3653varName :: String -> String
@@ -41,9 +58,9 @@ varName name =
4158 map (swap '\'' '$') saferName
4259
4360
44−value :: Module.Name -> String -> JS.Expression ()
45−value home name =
46− canonical (Var.Canonical (Var.Module home) name)
61+--value :: Module.Name -> String -> JS.Expression ()
62+--value home name =
63+-- canonical (Var.Canonical (Var.Module home) name)
4764
4865
4966jsReserveds :: Set.Set String
src/Nitpick/PatternMatches.hs+3−2
@@ -11,6 +11,7 @@ import qualified AST.Expression.General as E
1111import qualified AST.Expression.Canonical as Canonical
1212import qualified AST.Helpers as Help
1313import qualified AST.Module as Module
14+import qualified AST.Module.Name as ModuleName
1415import qualified AST.Pattern as Pattern
1516import qualified AST.Variable as Var
1617import Elm.Utils ((|>))
@@ -27,7 +28,7 @@ patternMatches
2728 -> Result.Result Warning.Warning e ()
2829patternMatches interfaces modul =
2930 let
30− name = Module.names modul
31+ name = Module.name modul
3132 body = Module.body modul
3233 in
3334 checkExpression
@@ -44,7 +45,7 @@ type TagDict =
4445type Tag = String
4546
4647
47−toTagDict :: Module.Interfaces -> Module.Name -> Module.ADTs -> TagDict
48+toTagDict :: Module.Interfaces -> ModuleName.Canonical -> Module.ADTs -> TagDict
4849toTagDict interfaces localName localAdts =
4950 let
5051 listTags =
src/Nitpick/TopLevelTypes.hs+49−29
@@ -7,9 +7,11 @@ import qualified Data.Map as Map
77
88import qualified AST.Expression.Valid as Valid
99import qualified AST.Declaration as Decl
10+import qualified AST.Module.Name as ModuleName
1011import qualified AST.Pattern as P
1112import qualified AST.Type as Type
1213import qualified AST.Variable as Var
14+import qualified Elm.Package as Pkg
1315import qualified Reporting.Annotation as A
1416import qualified Reporting.Error.Type as Error
1517import qualified Reporting.Result as Result
@@ -77,39 +79,57 @@ validMainTypes =
7779 , signal element
7880 , signal html
7981 ]
80− where
81− fromModule :: [String] -> String -> Type.Canonical
82− fromModule home name =
83− Type.Type (Var.fromModule home name)
8482
85− html =
86− fromModule ["VirtualDom"] "Node"
8783
88− signal tipe =
89− Type.App (fromModule ["Signal"] "Signal") [ tipe ]
84+html :: Type.Canonical
85+html =
86+ Type.Type (Var.fromModule virtualDom "Node")
9087
91− element =
92− let builtin name =
93− Type.Type (Var.builtin name)
9488
95− maybe tipe =
96− Type.App (fromModule ["Maybe"] "Maybe") [ tipe ]
97− in
89+virtualDom :: ModuleName.Canonical
90+virtualDom =
91+ ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"]
92+
93+
94+element :: Type.Canonical
95+element =
96+ Type.Record
97+ [ ("element", core ["Graphics","Element"] "ElementPrim")
98+ , ("props",
9899 Type.Record
99− [ ("element", fromModule ["Graphics","Element"] "ElementPrim")
100− , ("props",
101− Type.Record
102− [ ("click" , builtin "_Tuple0")
103− , ("color" , maybe (fromModule ["Color"] "Color"))
104− , ("height" , builtin "Int")
105− , ("hover" , builtin "_Tuple0")
106− , ("href" , builtin "String")
107− , ("id" , builtin "Int")
108− , ("opacity", builtin "Float")
109− , ("tag" , builtin "String")
110− , ("width" , builtin "Int")
111− ]
112− Nothing
113− )
100+ [ ("click" , builtin "_Tuple0")
101+ , ("color" , maybe (core ["Color"] "Color"))
102+ , ("height" , builtin "Int")
103+ , ("hover" , builtin "_Tuple0")
104+ , ("href" , builtin "String")
105+ , ("id" , builtin "Int")
106+ , ("opacity", builtin "Float")
107+ , ("tag" , builtin "String")
108+ , ("width" , builtin "Int")
114109 ]
115110 Nothing
111+ )
112+ ]
113+ Nothing
114+
115+
116+core :: [String] -> String -> Type.Canonical
117+core home name =
118+ Type.Type (Var.inCore home name)
119+
120+
121+signal :: Type.Canonical -> Type.Canonical
122+signal tipe =
123+ Type.App (core ["Signal"] "Signal") [ tipe ]
124+
125+
126+maybe :: Type.Canonical -> Type.Canonical
127+maybe tipe =
128+ Type.App (core ["Maybe"] "Maybe") [ tipe ]
129+
130+
131+builtin :: String -> Type.Canonical
132+builtin name =
133+ Type.Type (Var.builtin name)
134+
135+
src/Parse/Module.hs+8−4
@@ -5,6 +5,7 @@ import Text.Parsec hiding (newline, spaces)
55
66import Parse.Helpers
77import qualified AST.Module as Module
8+import qualified AST.Module.Name as ModuleName
89import qualified AST.Variable as Var
910import Reporting.Annotation as A
1011
@@ -12,13 +13,16 @@ import Reporting.Annotation as A
1213getModuleName :: String -> Maybe String
1314getModuleName source =
1415 case iParse getModuleName source of
15− Right name -> Just name
16− Left _ -> Nothing
16+ Right name ->
17+ Just name
18+
19+ Left _ ->
20+ Nothing
1721 where
1822 getModuleName =
1923 do optional freshLine
2024 (names, _) <- moduleDecl
21− return (Module.nameToString names)
25+ return (ModuleName.toString names)
2226
2327
2428header :: IParser (Module.Header [Module.UserImport])
@@ -60,7 +64,7 @@ import' =
6064 do try (reserved "import")
6165 whitespace
6266 names <- dotSep1 capVar
63− (,) names <$> method (Module.nameToString names)
67+ (,) names <$> method (ModuleName.toString names)
6468 where
6569 method :: String -> IParser Module.ImportMethod
6670 method defaultAlias =
src/Parse/Parse.hs+19−10
@@ -9,7 +9,9 @@ import qualified Text.Parsec.Error as Parsec
99
1010import qualified AST.Declaration as D
1111import qualified AST.Module as M
12+import qualified AST.Module.Name as ModuleName
1213import qualified Elm.Compiler.Imports as Imports
14+import qualified Elm.Package as Package
1315import Parse.Helpers
1416import qualified Parse.Module as Module
1517import qualified Parse.Declaration as Decl
@@ -20,33 +22,40 @@ import qualified Validate
2022
2123
2224program
23− :: Bool
25+ :: Package.Name
2426 -> Bool
2527 -> OpTable
2628 -> String
2729 -> Result.Result wrn Error.Error M.ValidModule
28−program needsDefaults isRoot table src =
29− do (M.Module names filePath docs exports imports sourceDecls) <-
30− parseWithTable table src programParser
30+program pkgName isRoot table src =
31+ do (M.Module name filePath docs exports imports sourceDecls) <-
32+ parseWithTable table src (programParser pkgName)
3133
3234 validDecls <- Validate.declarations isRoot sourceDecls
3335
36+ -- determine if default imports should be added, only elm-lang/core is exempt
3437 let ammendedImports =
35− (if needsDefaults then Imports.defaults else [], imports)
38+ ( if pkgName == Package.coreName then [] else Imports.defaults
39+ , imports
40+ )
3641
37− return (M.Module names filePath docs exports ammendedImports validDecls)
42+ return (M.Module name filePath docs exports ammendedImports validDecls)
3843
3944
4045-- HEADERS AND DECLARATIONS
4146
42−programParser :: IParser M.SourceModule
43−programParser =
44− do (M.Header names docs exports imports) <- Module.header
47+programParser :: Package.Name -> IParser M.SourceModule
48+programParser pkgName =
49+ do (M.Header name docs exports imports) <- Module.header
4550 decls <- declarations
4651 optional freshLine
4752 optional spaces
4853 eof
49− return $ M.Module names "" docs exports imports decls
54+
55+ let canonicalName =
56+ ModuleName.Canonical pkgName name
57+
58+ return $ M.Module canonicalName "" docs exports imports decls
5059
5160
5261declarations :: IParser [D.SourceDecl]
src/Reporting/Error/Canonicalize.hs+8−8
@@ -3,7 +3,7 @@ module Reporting.Error.Canonicalize where
33
44import qualified Text.PrettyPrint as P
55
6−import qualified AST.Module as Module
6+import qualified AST.Module.Name as ModuleName
77import qualified AST.Type as Type
88import qualified AST.Variable as Var
99import qualified Reporting.Error.Helpers as Help
@@ -16,7 +16,7 @@ data Error
1616 = Var VarError
1717 | Pattern PatternError
1818 | Alias AliasError
19− | Import Module.Name ImportError
19+ | Import ModuleName.Raw ImportError
2020 | Export String [String]
2121 | DuplicateExport String
2222 | Port PortError
@@ -58,16 +58,16 @@ argMismatch name expected actual =
5858-- IMPORTS
5959
6060data ImportError
61− = ModuleNotFound [Module.Name]
61+ = ModuleNotFound [ModuleName.Raw]
6262 | ValueNotFound String [String]
6363
6464
65−moduleNotFound :: Module.Name -> [Module.Name] -> Error
65+moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error
6666moduleNotFound name possibilities =
6767 Import name (ModuleNotFound possibilities)
6868
6969
70−valueNotFound :: Module.Name -> String -> [String] -> Error
70+valueNotFound :: ModuleName.Raw -> String -> [String] -> Error
7171valueNotFound name value possibilities =
7272 Import name (ValueNotFound value possibilities)
7373
@@ -178,13 +178,13 @@ toReport dealiaser err =
178178 ++ "line " ++ show (Region.line start)
179179
180180 Import name importError ->
181− let moduleName = Module.nameToString name
181+ let moduleName = ModuleName.toString name
182182 in
183183 case importError of
184184 ModuleNotFound suggestions ->
185185 namingError
186186 ("Could not find a module named `" ++ moduleName ++ "`")
187− (Help.maybeYouWant (map Module.nameToString suggestions))
187+ (Help.maybeYouWant (map ModuleName.toString suggestions))
188188
189189 ValueNotFound value suggestions ->
190190 namingError
@@ -249,7 +249,7 @@ extractSuggestions err =
249249 Import _ importError ->
250250 case importError of
251251 ModuleNotFound suggestions ->
252− Just (map Module.nameToString suggestions)
252+ Just (map ModuleName.toString suggestions)
253253
254254 ValueNotFound _ suggestions ->
255255 Just suggestions
src/Reporting/Warning.hs+3−3
@@ -7,7 +7,7 @@ import qualified Data.Aeson as Json
77import qualified Text.PrettyPrint as P
88import Text.PrettyPrint ((<+>))
99
10−import qualified AST.Module as Module
10+import qualified AST.Module.Name as ModuleName
1111import qualified AST.Type as Type
1212import qualified Nitpick.Pattern as Pattern
1313import qualified Reporting.Annotation as A
@@ -18,7 +18,7 @@ import qualified Reporting.Report as Report
1818-- ALL POSSIBLE WARNINGS
1919
2020data Warning
21− = UnusedImport Module.Name
21+ = UnusedImport ModuleName.Raw
2222 | MissingTypeAnnotation String Type.Canonical
2323 | InexhaustivePatternMatch [Pattern.Pattern]
2424 | RedundantPatternMatch
@@ -42,7 +42,7 @@ toReport dealiaser warning =
4242 UnusedImport moduleName ->
4343 Report.simple
4444 "unused import"
45− ("Module `" ++ Module.nameToString moduleName ++ "` is unused.")
45+ ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")
4646 ""
4747
4848 MissingTypeAnnotation name inferredType ->
src/Type/Inference.hs+28−20
@@ -6,6 +6,7 @@ import qualified Data.Map as Map
66import qualified Data.Traversable as Traverse
77
88import AST.Module as Module
9+import qualified AST.Module.Name as ModuleName
910import qualified AST.Type as Type
1011import qualified AST.Variable as Var
1112import qualified Reporting.Annotation as A
@@ -22,7 +23,7 @@ import System.IO.Unsafe
2223
2324
2425infer
25− :: Interfaces
26+ :: Module.Interfaces
2627 -> Module.CanonicalModule
2728 -> Except [A.Located Error.Error] (Map.Map String Type.Canonical)
2829infer interfaces modul =
@@ -39,7 +40,7 @@ infer interfaces modul =
3940
4041
4142genConstraints
42− :: Interfaces
43+ :: Module.Interfaces
4344 -> Module.CanonicalModule
4445 -> IO (Env.TypeDict, T.TypeConstraint)
4546genConstraints interfaces modul =
@@ -69,33 +70,40 @@ genConstraints interfaces modul =
6970
7071canonicalizeValues
7172 :: Env.Environment
72− -> (Module.Name, Interface)
73+ -> (ModuleName.Canonical, Interface)
7374 -> IO [(String, ([T.Variable], T.Type))]
7475canonicalizeValues env (moduleName, iface) =
7576 forM (Map.toList (iTypes iface)) $ \(name,tipe) ->
7677 do tipe' <- Env.instantiateType env tipe Map.empty
77− return (Module.nameToString moduleName ++ "." ++ name, tipe')
78+ return
79+ ( ModuleName.canonicalToString moduleName ++ "." ++ name
80+ , tipe'
81+ )
7882
7983
80−canonicalizeAdts :: Interfaces -> Module.CanonicalModule -> [CanonicalAdt]
84+canonicalizeAdts :: Module.Interfaces -> Module.CanonicalModule -> [CanonicalAdt]
8185canonicalizeAdts interfaces modul =
8286 localAdts ++ importedAdts
8387 where
8488 localAdts :: [CanonicalAdt]
85− localAdts = format (Module.names modul, datatypes (body modul))
89+ localAdts =
90+ format (Module.name modul, datatypes (body modul))
8691
8792 importedAdts :: [CanonicalAdt]
88− importedAdts = concatMap (format . second iAdts) (Map.toList interfaces)
89−
90− format :: (Module.Name, Module.ADTs) -> [CanonicalAdt]
91− format (home, adts) =
92− map canonical (Map.toList adts)
93− where
94− canonical :: (String, AdtInfo String) -> CanonicalAdt
95− canonical (name, (tvars, ctors)) =
96− ( toVar name
97− , (tvars, map (first toVar) ctors)
98− )
99−
100− toVar :: String -> Var.Canonical
101− toVar = Var.Canonical (Var.Module home)
93+ importedAdts =
94+ concatMap (format . second iAdts) (Map.toList interfaces)
95+
96+
97+format :: (ModuleName.Canonical, Module.ADTs) -> [CanonicalAdt]
98+format (home, adts) =
99+ map canonical (Map.toList adts)
100+ where
101+ canonical :: (String, AdtInfo String) -> CanonicalAdt
102+ canonical (name, (tvars, ctors)) =
103+ ( toVar name
104+ , (tvars, map (first toVar) ctors)
105+ )
106+
107+ toVar :: String -> Var.Canonical
108+ toVar name =
109+ Var.fromModule home name
tests/Test/Compiler.hs+1−1
@@ -54,7 +54,7 @@ testIf handleResult filePaths =
5454 source <- readFile filePath
5555
5656 let context =
57− Compiler.Context (Package.Name "elm-lang" "core") True False
57+ Compiler.Context Package.coreName True False []
5858 let (dealiaser, _warnings, result) =
5959 Compiler.compile context source Map.empty
6060 let formatErrors errors =