31545d1 · elk · git.iko.soy

elm-compiler.cabal+1

compare with master

unifiedsplit

@@ -56,6 +56,7 @@ Library

56 AST.Helpers,

57 AST.Literal,

58 AST.Module,

59+ AST.Module.Name,

59 AST.Pattern,

60 AST.Pattern,

60 AST.Type,

61 AST.Type,

61 AST.Variable,

62 AST.Variable,

src/AST/Module.hs+15−40

@@ -1,24 +1,22 @@

1module AST.Module

2− ( Interfaces, CanonicalInterfaces

2+ ( Interfaces

3 , Types, Aliases, ADTs

4 , AdtInfo, CanonicalAdt

5 , SourceModule, ValidModule, CanonicalModule, Optimized

6 , Module(..), Body(..)

7 , Header(..)

8− , Name, nameToString, nameIsNative

9− , CanonicalName(..), canonPkg, canonModul

10 , Interface(..), toInterface

8 , Interface(..), toInterface

11 , UserImport, DefaultImport, ImportMethod(..)

9 , UserImport, DefaultImport, ImportMethod(..)

12 ) where

10 ) where

13

11

14import Control.Applicative ((<$>),(<*>))

12import Control.Applicative ((<$>),(<*>))

15import Data.Binary

13import Data.Binary

16−import qualified Data.List as List

17import qualified Data.Map as Map

14import qualified Data.Map as Map

18

15

19import qualified AST.Declaration as Decl

16import qualified AST.Declaration as Decl

20import qualified AST.Expression.Canonical as Canonical

17import qualified AST.Expression.Canonical as Canonical

21import qualified AST.Expression.Optimized as Optimized

18import qualified AST.Expression.Optimized as Optimized

19+import qualified AST.Module.Name as Name

22import qualified AST.Type as Type

20import qualified AST.Type as Type

23import qualified AST.Variable as Var

21import qualified AST.Variable as Var

24import qualified Docs.AST as Docs

22import qualified Docs.AST as Docs

@@ -29,8 +27,7 @@ import qualified Reporting.Annotation as A

29

27

30-- HELPFUL TYPE ALIASES

28-- HELPFUL TYPE ALIASES

31

29

32−type Interfaces = Map.Map Name Interface

30+type Interfaces = Map.Map Name.Canonical Interface

33−type CanonicalInterfaces = Map.Map CanonicalName Interface

34

31

35type Types = Map.Map String Type.Canonical

32type Types = Map.Map String Type.Canonical

36type Aliases = Map.Map String ([String], Type.Canonical)

33type Aliases = Map.Map String ([String], Type.Canonical)

@@ -59,15 +56,15 @@ type ValidModule =

59

56

60

57

61type CanonicalModule =

58type CanonicalModule =

62− Module Docs.Centralized [Name] [Var.Value] (Body Canonical.Expr)

59+ Module Docs.Centralized [Name.Raw] [Var.Value] (Body Canonical.Expr)

63

60

64

61

65type Optimized =

62type Optimized =

66− Module Docs.Centralized [Name] [Var.Value] (Body Optimized.Expr)

63+ Module Docs.Centralized [Name.Raw] [Var.Value] (Body Optimized.Expr)

67

64

68

65

69data Module docs imports exports body = Module

66data Module docs imports exports body = Module

70− { names :: Name

67+ { name :: Name.Canonical

71 , path :: FilePath

68 , path :: FilePath

72 , docs :: A.Located (Maybe docs)

69 , docs :: A.Located (Maybe docs)

73 , exports :: exports

70 , exports :: exports

@@ -90,41 +87,19 @@ data Body expr = Body

90

87

91{-| Basic info needed to identify modules and determine dependencies. -}

88{-| Basic info needed to identify modules and determine dependencies. -}

92data Header imports = Header

89data Header imports = Header

93− { _names :: Name

90+ { _name :: Name.Raw

94 , _docs :: A.Located (Maybe String)

91 , _docs :: A.Located (Maybe String)

95 , _exports :: Var.Listing (A.Located Var.Value)

92 , _exports :: Var.Listing (A.Located Var.Value)

96 , _imports :: imports

93 , _imports :: imports

97 }

94 }

98

95

99

96

100−type Name = [String] -- must be non-empty

101−

102−

103−data CanonicalName =

104− CanonicalName

105− { canonPkg :: Package.Name

106− , canonModul :: Name

107− }

108−

109−

110−nameToString :: Name -> String

111−nameToString =

112− List.intercalate "."

113−

114−

115−nameIsNative :: Name -> Bool

116−nameIsNative name =

117− case name of

118− "Native" : _ -> True

119− _ -> False

120−

121−

122-- IMPORTs

97-- IMPORTs

123

98

124−type UserImport = A.Located (Name, ImportMethod)

99+type UserImport = A.Located (Name.Raw, ImportMethod)

125

100

126

101

127−type DefaultImport = (Name, ImportMethod)

102+type DefaultImport = (Name.Raw, ImportMethod)

128

103

129

104

130data ImportMethod = ImportMethod

105data ImportMethod = ImportMethod

@@ -137,15 +112,15 @@ data ImportMethod = ImportMethod

137

112

138{-| Key facts about a module, used when reading info from .elmi files. -}

113{-| Key facts about a module, used when reading info from .elmi files. -}

139data Interface = Interface

114data Interface = Interface

140− { iVersion :: String

115+ { iVersion :: Package.Version

116+ , iPackage :: Package.Name

141 , iExports :: [Var.Value]

117 , iExports :: [Var.Value]

142 , iTypes :: Types

118 , iTypes :: Types

143− , iImports :: [Name]

119+ , iImports :: [Name.Raw]

144 , iAdts :: ADTs

120 , iAdts :: ADTs

145 , iAliases :: Aliases

121 , iAliases :: Aliases

146 , iFixities :: [(Decl.Assoc, Int, String)]

122 , iFixities :: [(Decl.Assoc, Int, String)]

147 , iPorts :: [String]

123 , iPorts :: [String]

148− , iPackage :: Package.Name

149 }

124 }

150

125

151

126

@@ -153,7 +128,8 @@ toInterface :: Package.Name -> CanonicalModule -> Interface

153toInterface pkgName modul =

128toInterface pkgName modul =

154 let body' = body modul in

129 let body' = body modul in

155 Interface

130 Interface

156− { iVersion = Package.versionToString Compiler.version

131+ { iVersion = Compiler.version

132+ , iPackage = pkgName

157 , iExports = exports modul

133 , iExports = exports modul

158 , iTypes = types body'

134 , iTypes = types body'

159 , iImports = imports modul

135 , iImports = imports modul

@@ -161,7 +137,6 @@ toInterface pkgName modul =

161 , iAliases = aliases body'

137 , iAliases = aliases body'

162 , iFixities = fixities body'

138 , iFixities = fixities body'

163 , iPorts = ports body'

139 , iPorts = ports body'

164− , iPackage = pkgName

165 }

140 }

166

141

167

142

@@ -169,6 +144,7 @@ instance Binary Interface where

169 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

144 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

170 put modul = do

145 put modul = do

171 put (iVersion modul)

146 put (iVersion modul)

147+ put (iPackage modul)

172 put (iExports modul)

148 put (iExports modul)

173 put (iTypes modul)

149 put (iTypes modul)

174 put (iImports modul)

150 put (iImports modul)

@@ -176,4 +152,3 @@ instance Binary Interface where

176 put (iAliases modul)

152 put (iAliases modul)

177 put (iFixities modul)

153 put (iFixities modul)

178 put (iPorts modul)

154 put (iPorts modul)

179− put (iPackage 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

2

3import Control.Applicative ((<$>), (<*>))

4import Data.Binary

5−import qualified Data.List as List

6import qualified Data.Map as Map

5import qualified Data.Map as Map

7import qualified Data.Maybe as Maybe

6import qualified Data.Maybe as Maybe

8import Text.PrettyPrint as P

7import Text.PrettyPrint as P

9

8

10import qualified AST.Helpers as Help

9import qualified AST.Helpers as Help

10+import qualified AST.Module.Name as ModuleName

11import qualified Reporting.PrettyPrint as P

12

13

@@ -19,8 +19,8 @@ newtype Raw = Raw String

19

20data Home

21 = BuiltIn

22− | Module [String]

22+ | Module ModuleName.Canonical

23− | TopLevel [String]

23+ | TopLevel ModuleName.Canonical

24 | Local

25 deriving (Eq, Ord, Show)

26

@@ -37,9 +37,9 @@ local x =

37 Canonical Local x

38

39

40−topLevel :: [String] -> String -> Canonical

40+topLevel :: ModuleName.Canonical -> String -> Canonical

41−topLevel names x =

41+topLevel home x =

42− Canonical (TopLevel names) x

42+ Canonical (TopLevel home) x

43

44

45builtin :: String -> Canonical

@@ -47,16 +47,21 @@ builtin x =

47 Canonical BuiltIn x

48

49

50−fromModule :: [String] -> String -> Canonical

50+fromModule :: ModuleName.Canonical -> String -> Canonical

51fromModule home name =

52 Canonical (Module home) name

53

54

55+inCore :: ModuleName.Raw -> String -> Canonical

56+inCore home name =

57+ Canonical (Module (ModuleName.inCore home)) name

58+

59+

55-- VARIABLE RECOGNIZERS

60-- VARIABLE RECOGNIZERS

56

61

57−is :: [String] -> String -> Canonical -> Bool

62+is :: ModuleName.Raw -> String -> Canonical -> Bool

58is home name var =

63is home name var =

59− var == Canonical (Module home) name

64+ var == inCore home name

60

65

61

66

62isJson :: Canonical -> Bool

67isJson :: Canonical -> Bool

@@ -133,8 +138,8 @@ instance ToString Canonical where

133 BuiltIn ->

138 BuiltIn ->

134 name

139 name

135

140

136− Module path ->

141+ Module moduleName ->

137− List.intercalate "." (path ++ [name])

142+ ModuleName.canonicalToString moduleName ++ "." ++ name

138

143

139 TopLevel _ ->

144 TopLevel _ ->

140 name

145 name

src/Canonicalize.hs+17−8

@@ -10,12 +10,14 @@ import qualified Data.Foldable as T

10

11import AST.Expression.General (Expr'(..), dummyLet)

12import AST.Module (Body(..))

13+import Elm.Utils ((|>))

13

14

14import qualified AST.Declaration as D

15import qualified AST.Declaration as D

15import qualified AST.Expression.General as E

16import qualified AST.Expression.General as E

16import qualified AST.Expression.Valid as Valid

17import qualified AST.Expression.Valid as Valid

17import qualified AST.Expression.Canonical as Canonical

18import qualified AST.Expression.Canonical as Canonical

18import qualified AST.Module as Module

19import qualified AST.Module as Module

20+import qualified AST.Module.Name as ModuleName

19import qualified AST.Pattern as P

21import qualified AST.Pattern as P

20import qualified AST.Type as Type

22import qualified AST.Type as Type

21import qualified AST.Variable as Var

23import qualified AST.Variable as Var

@@ -41,13 +43,19 @@ import qualified Canonicalize.Variable as Canonicalize

41-- MODULES

43-- MODULES

42

44

43module'

45module'

46+ :: [ModuleName.Canonical]

44− :: Module.Interfaces

47+ -> Module.Interfaces

45 -> Module.ValidModule

48 -> Module.ValidModule

46 -> R.Result Warning.Warning Error.Error Module.CanonicalModule

49 -> R.Result Warning.Warning Error.Error Module.CanonicalModule

47−module' interfaces modul =

50+module' canonicalImports interfaces modul =

48 let

51 let

52+ importDict =

53+ canonicalImports

54+ |> map (\cName -> (ModuleName._module cName, cName))

55+ |> Map.fromList

56+

49 (Result.Result uses rawResults) =

57 (Result.Result uses rawResults) =

50− moduleHelp interfaces modul

58+ moduleHelp importDict interfaces modul

51 in

59 in

52 case rawResults of

60 case rawResults of

53 Result.Ok (env, almostCanonicalModule) ->

61 Result.Ok (env, almostCanonicalModule) ->

@@ -67,10 +75,11 @@ type AlmostCanonicalModule =

67

75

68

76

69moduleHelp

77moduleHelp

78+ :: Map.Map ModuleName.Raw ModuleName.Canonical

70− :: Module.Interfaces

79+ -> Module.Interfaces

71 -> Module.ValidModule

80 -> Module.ValidModule

72 -> Result.ResultErr (Env.Environment, AlmostCanonicalModule)

81 -> Result.ResultErr (Env.Environment, AlmostCanonicalModule)

73−moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =

82+moduleHelp importDict interfaces modul@(Module.Module _ _ comment exports _ decls) =

74 canonicalModule

83 canonicalModule

75 <$> canonicalDeclsResult

84 <$> canonicalDeclsResult

76 <*> resolveExports locals exports

85 <*> resolveExports locals exports

@@ -88,7 +97,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =

88 concatMap declToValue decls

97 concatMap declToValue decls

89

98

90 canonicalDeclsResult =

99 canonicalDeclsResult =

91− Setup.environment interfaces modul

100+ Setup.environment importDict interfaces modul

92 `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls

101 `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls

93

102

94 body :: [D.CanonicalDecl] -> Module.Body Canonical.Expr

103 body :: [D.CanonicalDecl] -> Module.Body Canonical.Expr

@@ -97,7 +106,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =

97 in

106 in

98 Module.Body

107 Module.Body

99 { program =

108 { program =

100− let expr = Decls.toExpr (Module.names modul) decls

109+ let expr = Decls.toExpr (Module.name modul) decls

101 in

110 in

102 Sort.definitions (dummyLet expr)

111 Sort.definitions (dummyLet expr)

103

112

@@ -121,7 +130,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =

121-- IMPORTS

130-- IMPORTS

122

131

123filterImports

132filterImports

124− :: Set.Set Module.Name

133+ :: Set.Set ModuleName.Raw

125 -> AlmostCanonicalModule

134 -> AlmostCanonicalModule

126 -> R.Result Warning.Warning e Module.CanonicalModule

135 -> R.Result Warning.Warning e Module.CanonicalModule

127filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) =

136filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) =

src/Canonicalize/Declaration.hs+3−3

@@ -4,7 +4,7 @@ module Canonicalize.Declaration (toExpr) where

4import qualified AST.Declaration as D

5import qualified AST.Expression.General as E

6import qualified AST.Expression.Canonical as Canonical

7−import qualified AST.Module as Module

7+import qualified AST.Module.Name as ModuleName

8import qualified AST.Pattern as P

9import qualified AST.Type as T

10import qualified AST.Variable as Var

@@ -12,12 +12,12 @@ import qualified Reporting.Annotation as A

12import qualified Reporting.Region as R

13

14

15−toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]

15+toExpr :: ModuleName.Canonical -> [D.CanonicalDecl] -> [Canonical.Def]

16toExpr moduleName decls =

17 concatMap (toDefs moduleName) decls

18

19

20−toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]

20+toDefs :: ModuleName.Canonical -> D.CanonicalDecl -> [Canonical.Def]

21toDefs moduleName (A.A (region,_) decl) =

22 let typeVar = Var.fromModule moduleName

23

src/Canonicalize/Environment.hs+3−3

@@ -7,7 +7,7 @@ import qualified Data.Maybe as Maybe

7import qualified Data.Set as Set

8

9import AST.Expression.General (saveEnvName)

10−import qualified AST.Module as Module

10+import qualified AST.Module.Name as ModuleName

11import qualified AST.Pattern as P

12import qualified AST.Type as Type

13import qualified AST.Variable as Var

@@ -17,7 +17,7 @@ import Elm.Utils ((|>))

17-- ENVIRONMENT

18

19data Environment = Env

20− { _home :: Module.Name

20+ { _home :: ModuleName.Canonical

21 , _values :: Dict Var.Canonical

22 , _adts :: Dict Var.Canonical

23 , _aliases :: Dict (Var.Canonical, [String], Type.Canonical)

@@ -29,7 +29,7 @@ type Dict a =

29 Map.Map String (Set.Set a)

30

31

32−fromPatches :: Module.Name -> [Patch] -> Environment

32+fromPatches :: ModuleName.Canonical -> [Patch] -> Environment

33fromPatches moduleName patches =

34 addPatches

35 patches

src/Canonicalize/Result.hs+4−4

@@ -6,7 +6,7 @@ import qualified Control.Applicative as A

6import qualified Data.Functor as F

7import qualified Data.Set as Set

8

9−import qualified AST.Module as Module

9+import qualified AST.Module.Name as ModuleName

10import qualified AST.Variable as Var

11import qualified Reporting.Annotation as A

12import qualified Reporting.Error.Canonicalize as Error

@@ -16,7 +16,7 @@ type ResultErr a = Result (A.Located Error.Error) a

16

17

18data Result err a =

19− Result (Set.Set Module.Name) (RawResult err a)

19+ Result (Set.Set ModuleName.Raw) (RawResult err a)

20

21

22data RawResult err a

@@ -95,7 +95,7 @@ instance A.Applicative (Result e) where

95

96-- TRACK USES OF IMPORTS

97

98−addModule :: Module.Name -> Result e a -> Result e a

98+addModule :: ModuleName.Raw -> Result e a -> Result e a

99addModule home (Result uses result) =

100 Result (Set.insert home uses) result

101

@@ -103,7 +103,7 @@ addModule home (Result uses result) =

103var' :: (a -> Var.Canonical) -> a -> Result e a

104var' toVar value =

105 case toVar value of

106− Var.Canonical (Var.Module moduleName) _name ->

106+ Var.Canonical (Var.Module (ModuleName.Canonical _ moduleName)) _name ->

107 Result (Set.singleton moduleName) (Ok value)

108

109 Var.Canonical _ _ ->

src/Canonicalize/Setup.hs+39−31

@@ -11,6 +11,7 @@ import qualified Data.Traversable as Trav

11import qualified AST.Declaration as D

12import qualified AST.Expression.Valid as Valid

13import qualified AST.Module as Module

14+import qualified AST.Module.Name as ModuleName

14import qualified AST.Pattern as P

15import qualified AST.Pattern as P

15import qualified AST.Type as Type

16import qualified AST.Type as Type

16import qualified AST.Variable as Var

17import qualified AST.Variable as Var

@@ -25,50 +26,57 @@ import qualified Canonicalize.Type as Canonicalize

25

26

27

27environment

28environment

29+ :: Map.Map ModuleName.Raw ModuleName.Canonical

28− :: Module.Interfaces

30+ -> Module.Interfaces

29 -> Module.ValidModule

31 -> Module.ValidModule

30 -> Result.ResultErr Env.Environment

32 -> Result.ResultErr Env.Environment

31−environment interfaces modul@(Module.Module _ _ _ _ (defaults, imports) decls) =

33+environment importDict interfaces (Module.Module name _ _ _ (defaults, imports) decls) =

32− let moduleName =

34+ let

33− Module.names modul

35+ allImports =

36+ imports ++ map (A.A (error "default import not found")) defaults

34

37

35− allImports =

38+ importPatchesResult =

36− imports ++ map (A.A (error "default import not found")) defaults

39+ concat <$> Trav.traverse (importPatches importDict interfaces) allImports

37

40

38− importPatchesResult =

41+ (typeAliasNodes, declPatches) =

39− concat <$> Trav.traverse (importPatches interfaces) allImports

42+ declarationsToPatches name decls

40

43

41− (typeAliasNodes, declPatches) =

42− declarationsToPatches moduleName decls

43−

44− patches =

44+ patches =

45− (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult

45+ (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult

46 in

47− (Env.fromPatches moduleName <$> patches)

47+ (Env.fromPatches name <$> patches)

48− `Result.andThen` addTypeAliases moduleName typeAliasNodes

48+ `Result.andThen` addTypeAliases name typeAliasNodes

49

50

51-- PATCHES FOR IMPORTS

52

53importPatches

54+ :: Map.Map ModuleName.Raw ModuleName.Canonical

54− :: Module.Interfaces

55+ -> Module.Interfaces

55− -> A.Located (Module.Name, Module.ImportMethod)

56+ -> A.Located (ModuleName.Raw, Module.ImportMethod)

56 -> Result.ResultErr [Env.Patch]

57 -> Result.ResultErr [Env.Patch]

57−importPatches allInterfaces (A.A region (importName, method)) =

58+importPatches importDict allInterfaces (A.A region (rawImportName, method)) =

58− case restrictToPublicApi <$> Map.lookup importName allInterfaces of

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

59 Nothing ->

66 Nothing ->

60− if Module.nameIsNative importName then

67+ if ModuleName.isNative rawImportName then

61 Result.ok []

68 Result.ok []

62

69

63 else

70 else

64 allInterfaces

71 allInterfaces

65 |> Map.keys

72 |> Map.keys

66− |> Error.nearbyNames Module.nameToString importName

73+ |> map ModuleName._module

74+ |> Error.nearbyNames ModuleName.toString rawImportName

67− |> Error.moduleNotFound importName

75+ |> Error.moduleNotFound rawImportName

68 |> A.A region

76 |> A.A region

69 |> Result.err

77 |> Result.err

70

78

71− Just interface ->

79+ Just (importName, interface) ->

72 let (Module.ImportMethod maybeAlias listing) =

80 let (Module.ImportMethod maybeAlias listing) =

73 method

81 method

74

82

@@ -76,7 +84,7 @@ importPatches allInterfaces (A.A region (importName, method)) =

76 listing

84 listing

77

85

78 qualifier =

86 qualifier =

79− maybe (Module.nameToString importName) id maybeAlias

87+ maybe (ModuleName.toString rawImportName) id maybeAlias

80

88

81 qualifiedPatches =

89 qualifiedPatches =

82 interfacePatches importName (qualifier ++ ".") interface

90 interfacePatches importName (qualifier ++ ".") interface

@@ -89,7 +97,7 @@ importPatches allInterfaces (A.A region (importName, method)) =

89 (++) qualifiedPatches <$> unqualifiedPatches

97 (++) qualifiedPatches <$> unqualifiedPatches

90

98

91

99

92−interfacePatches :: Module.Name -> String -> Module.Interface -> [Env.Patch]

100+interfacePatches :: ModuleName.Canonical -> String -> Module.Interface -> [Env.Patch]

93interfacePatches moduleName prefix interface =

101interfacePatches moduleName prefix interface =

94 let genericPatch mkPatch name value =

102 let genericPatch mkPatch name value =

95 mkPatch (prefix ++ name) value

103 mkPatch (prefix ++ name) value

@@ -124,7 +132,7 @@ interfacePatches moduleName prefix interface =

124

132

125valueToPatches

133valueToPatches

126 :: R.Region

134 :: R.Region

127− -> Module.Name

135+ -> ModuleName.Canonical

128 -> Module.Interface

136 -> Module.Interface

129 -> Var.Value

137 -> Var.Value

130 -> Result.ResultErr [Env.Patch]

138 -> Result.ResultErr [Env.Patch]

@@ -139,7 +147,7 @@ valueToPatches region moduleName interface value =

139 Module.iExports interface

147 Module.iExports interface

140 |> getNames

148 |> getNames

141 |> Error.nearbyNames id x

149 |> Error.nearbyNames id x

142− |> Error.valueNotFound moduleName x

150+ |> Error.valueNotFound (ModuleName._module moduleName) x

143 |> A.A region

151 |> A.A region

144 |> Result.err

152 |> Result.err

145 in

153 in

@@ -232,7 +240,7 @@ node region name tvars alias =

232

240

233

241

234addTypeAliases

242addTypeAliases

235− :: Module.Name

243+ :: ModuleName.Canonical

236 -> [Node]

244 -> [Node]

237 -> Env.Environment

245 -> Env.Environment

238 -> Result.ResultErr Env.Environment

246 -> Result.ResultErr Env.Environment

@@ -244,7 +252,7 @@ addTypeAliases moduleName typeAliasNodes initialEnv =

244

252

245

253

246addTypeAlias

254addTypeAlias

247− :: Module.Name

255+ :: ModuleName.Canonical

248 -> Graph.SCC (R.Region, String, [String], Type.Raw)

256 -> Graph.SCC (R.Region, String, [String], Type.Raw)

249 -> Env.Environment

257 -> Env.Environment

250 -> Result.ResultErr Env.Environment

258 -> Result.ResultErr Env.Environment

@@ -272,7 +280,7 @@ addTypeAlias moduleName scc env =

272-- DECLARATIONS TO PATCHES

280-- DECLARATIONS TO PATCHES

273

281

274declarationsToPatches

282declarationsToPatches

275− :: Module.Name

283+ :: ModuleName.Canonical

276 -> [D.ValidDecl]

284 -> [D.ValidDecl]

277 -> ([Node], [Env.Patch])

285 -> ([Node], [Env.Patch])

278declarationsToPatches moduleName decls =

286declarationsToPatches moduleName decls =

@@ -288,7 +296,7 @@ declarationsToPatches moduleName decls =

288-- _values that are defined as top-level declarations are (Var.TopLevel ...)

296-- _values that are defined as top-level declarations are (Var.TopLevel ...)

289-- all other _values are local (Var.Local)

297-- all other _values are local (Var.Local)

290declToPatches

298declToPatches

291− :: Module.Name

299+ :: ModuleName.Canonical

292 -> D.ValidDecl

300 -> D.ValidDecl

293 -> (Maybe Node, [Env.Patch])

301 -> (Maybe Node, [Env.Patch])

294declToPatches moduleName (A.A (region,_) decl) =

302declToPatches moduleName (A.A (region,_) decl) =

src/Canonicalize/Variable.hs+11−11

@@ -6,7 +6,7 @@ import qualified Data.Map as Map

6import qualified Data.Set as Set

7

8import qualified AST.Helpers as Help

9−import qualified AST.Module as Module

9+import qualified AST.Module.Name as ModuleName

10import qualified AST.Type as Type

11import qualified AST.Variable as Var

12import qualified Reporting.Annotation as A

@@ -22,8 +22,8 @@ variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canoni

22variable region env var =

23 case toVarName var of

24 Right (name, varName)

25− | Module.nameIsNative name ->

25+ | ModuleName.isNative name ->

26− Result.var (Var.Canonical (Var.Module name) varName)

26+ error "TODO" "Result.var (Var.Canonical (Var.Module name) varName)"

27

28 _ ->

29 case Set.toList `fmap` Map.lookup var (Env._values env) of

@@ -134,7 +134,7 @@ preferLocals' region env extract kind possibilities var =

134 vars = map (Var.toString . extract) possibleVars

135

136

137−isLocal :: [String] -> Var.Canonical -> Bool

137+isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool

138isLocal contextName (Var.Canonical home _) =

139 case home of

140 Var.Local ->

@@ -163,7 +163,7 @@ isTopLevel (Var.Canonical home _) =

163-- NOT FOUND HELPERS

164

165type VarName =

166− Either String (Module.Name, String)

166+ Either String (ModuleName.Raw, String)

167

168

169toVarName :: String -> VarName

@@ -180,9 +180,9 @@ noQualifier name =

180 Right (_, x) -> x

181

182

183−qualifiedToString :: (Module.Name, String) -> String

183+qualifiedToString :: (ModuleName.Raw, String) -> String

184qualifiedToString (modul, name) =

185− Module.nameToString (modul ++ [name])

185+ ModuleName.toString modul ++ "." ++ name

186

187

188isOp :: VarName -> Bool

@@ -225,16 +225,16 @@ exposedProblem name possibleNames =

225

226

227qualifiedProblem

228− :: Module.Name

228+ :: ModuleName.Raw

229 -> String

230− -> [(Module.Name, String)]

230+ -> [(ModuleName.Raw, String)]

231 -> (Error.VarProblem, [String])

232qualifiedProblem moduleName name allQualified =

233 let availableModules =

234 Set.fromList (map fst allQualified)

235

236 moduleNameString =

237− Module.nameToString moduleName

237+ ModuleName.toString moduleName

238 in

239 case Set.member moduleName availableModules of

240 True ->

@@ -248,6 +248,6 @@ qualifiedProblem moduleName name allQualified =

248 False ->

249 ( Error.UnknownQualifier moduleNameString name

250 , Set.toList availableModules

251− |> map Module.nameToString

251+ |> map ModuleName.toString

252 |> Error.nearbyNames id moduleNameString

253 )

src/Compile.hs+9−33

@@ -3,6 +3,7 @@ module Compile (compile) where

3import qualified Data.Map as Map

4

5import qualified AST.Module as Module

6+import qualified AST.Module.Name as ModuleName

6import qualified Canonicalize

7import qualified Canonicalize

7import Elm.Utils ((|>))

8import Elm.Utils ((|>))

8import qualified Elm.Package as Package

9import qualified Elm.Package as Package

@@ -17,31 +18,23 @@ import qualified Type.Inference as TI

17

18

19

19compile

20compile

20− :: Map.Map Module.Name Package.Name

21− -> Package.Name

21+ :: Package.Name

22 -> Bool

23− -> Module.CanonicalInterfaces

23+ -> [ModuleName.Canonical]

24+ -> Module.Interfaces

24 -> String

25 -> String

25 -> Result.Result Warning.Warning Error.Error Module.CanonicalModule

26 -> Result.Result Warning.Warning Error.Error Module.CanonicalModule

26

27

27−compile importedPackages packageName isRoot interfaces source =

28+compile packageName isRoot canonicalImports interfaces source =

28 do

29 do

29− -- determine if default imports should be added

30− -- only elm-lang/core is exempt

31− let needsDefaults =

32− not (packageName == Package.coreName)

33−

34− let normalInterfaces =

35− unCanonicalizeInterfaces importedPackages interfaces

36−

37 -- Parse the source code

30 -- Parse the source code

38 validModule <-

31 validModule <-

39 Result.mapError Error.Syntax $

32 Result.mapError Error.Syntax $

40− Parse.program needsDefaults isRoot (getOpTable interfaces) source

33+ Parse.program packageName isRoot (getOpTable interfaces) source

41

34

42 -- Canonicalize all variables, pinning down where they came from.

35 -- Canonicalize all variables, pinning down where they came from.

43 canonicalModule <-

36 canonicalModule <-

44− Canonicalize.module' normalInterfaces validModule

37+ Canonicalize.module' canonicalImports interfaces validModule

45

38

46 -- Run type inference on the program.

39 -- Run type inference on the program.

47 types <-

40 types <-

@@ -52,7 +45,7 @@ compile importedPackages packageName isRoot interfaces source =

52 Result.mapError Error.Type $

45 Result.mapError Error.Type $

53 Nitpick.topLevelTypes types (Module.body validModule)

46 Nitpick.topLevelTypes types (Module.body validModule)

54

47

55− Nitpick.patternMatches normalInterfaces canonicalModule

48+ Nitpick.patternMatches interfaces canonicalModule

56

49

57 -- Add the real list of types

50 -- Add the real list of types

58 let body = (Module.body canonicalModule) { Module.types = types }

51 let body = (Module.body canonicalModule) { Module.types = types }

@@ -60,26 +53,9 @@ compile importedPackages packageName isRoot interfaces source =

60 return $ canonicalModule { Module.body = body }

53 return $ canonicalModule { Module.body = body }

61

54

62

55

63−getOpTable :: Module.CanonicalInterfaces -> Parse.OpTable

56+getOpTable :: Module.Interfaces -> Parse.OpTable

64getOpTable interfaces =

57getOpTable interfaces =

65 Map.elems interfaces

58 Map.elems interfaces

66 |> concatMap Module.iFixities

59 |> concatMap Module.iFixities

67 |> map (\(assoc,lvl,op) -> (op,(lvl,assoc)))

60 |> map (\(assoc,lvl,op) -> (op,(lvl,assoc)))

68 |> Map.fromList

61 |> Map.fromList

69−

70−

71−unCanonicalizeInterfaces

72− :: Map.Map Module.Name Package.Name

73− -> Module.CanonicalInterfaces

74− -> Module.Interfaces

75−unCanonicalizeInterfaces packageInfo ifaces =

76− let

77− foldFun canonName iface mapSoFar =

78− case Map.lookup (Module.canonModul canonName) packageInfo of

79− Just pkg | pkg == Module.iPackage iface ->

80− Map.insert (Module.canonModul canonName) iface mapSoFar

81−

82− _ ->

83− mapSoFar

84− in

85− Map.foldrWithKey foldFun Map.empty ifaces

src/Elm/Compiler.hs+10−13

@@ -50,9 +50,9 @@ parseDependencies sourceCode =

50 Result.Err msgs ->

51 Left $ map (Error . A.map Error.Syntax) msgs

52

53− Result.Ok (Module.Header names _docs _exports imports) ->

53+ Result.Ok (Module.Header name _docs _exports imports) ->

54 Right

55− ( PublicModule.Name names

55+ ( PublicModule.Name name

56 , map (PublicModule.Name . fst . A.drop) imports

57 )

58

@@ -63,22 +63,16 @@ parseDependencies sourceCode =

63compile

64 :: Context

65 -> String

66− -> Map.Map PublicModule.CanonicalName PublicModule.Interface

66+ -> PublicModule.Interfaces

67 -> (Dealiaser, [Warning], Either [Error] Result)

68

69compile context source interfaces =

70 let

71− (Context packageName isRoot isExposed modulePackages) =

71+ (Context packageName isRoot isExposed dependencies) =

72 context

73

74− unwrappedInterfaces =

75− Map.mapKeysMonotonic PublicModule.fromCanonicalName interfaces

76−

77− unwrappedPackages =

78− Map.mapKeysMonotonic (\(PublicModule.Name strs) -> strs ) modulePackages

79−

80 (Result.Result (dealiaser, warnings) rawResult) =

74 (Result.Result (dealiaser, warnings) rawResult) =

81− do modul <- Compile.compile unwrappedPackages packageName isRoot unwrappedInterfaces source

75+ do modul <- Compile.compile packageName isRoot dependencies interfaces source

82 docs <- docsGen isExposed modul

76 docs <- docsGen isExposed modul

83

77

84 let interface = Module.toInterface packageName modul

78 let interface = Module.toInterface packageName modul

@@ -97,7 +91,7 @@ data Context = Context

97 { _packageName :: Package.Name

91 { _packageName :: Package.Name

98 , _isRoot :: Bool

92 , _isRoot :: Bool

99 , _isExposed :: Bool

93 , _isExposed :: Bool

100− , _modulePackages :: Map.Map PublicModule.Name Package.Name

94+ , _dependencies :: [PublicModule.Canonical]

101 }

95 }

102

96

103

97

@@ -120,8 +114,11 @@ docsGen isExposed modul =

120 getChecked =

114 getChecked =

121 Docs.check (Module.exports modul) (Module.docs modul)

115 Docs.check (Module.exports modul) (Module.docs modul)

122

116

117+ name =

118+ PublicModule.Name (PublicModule._module (Module.name modul))

119+

123 toDocs checked =

120 toDocs checked =

124− Docs.fromCheckedDocs (PublicModule.Name (Module.names modul)) checked

121+ Docs.fromCheckedDocs name checked

125 in

122 in

126 (Just . toDocs) `fmap` Result.mapError Error.Docs getChecked

123 (Just . toDocs) `fmap` Result.mapError Error.Docs getChecked

127

124

src/Elm/Compiler/Module.hs+6−29

@@ -1,13 +1,12 @@

1module Elm.Compiler.Module

2− ( Interface, Name(Name), name

2+ ( Interface, Interfaces, Name(Name)

3− , CanonicalName(CanonicalName), canonicalName, canonPkg, canonModul

4− , fromCanonicalName, canonFromPackage

5 , nameToPath

3 , nameToPath

6 , nameToString, nameFromString

4 , nameToString, nameFromString

7 , hyphenate, dehyphenate

5 , hyphenate, dehyphenate

8 , defaultImports

6 , defaultImports

9 , interfacePorts

7 , interfacePorts

10 , interfaceAliasedTypes

8 , interfaceAliasedTypes

9+ , ModuleName.Canonical(..)

11 )

10 )

12 where

11 where

13

12

@@ -21,10 +20,10 @@ import qualified Data.Text as Text

21import System.FilePath ((</>))

20import System.FilePath ((</>))

22

21

23import qualified AST.Module as Module

22import qualified AST.Module as Module

23+import qualified AST.Module.Name as ModuleName

24import qualified Elm.Compiler.Imports as Imports

25import qualified Elm.Compiler.Type as Type

26import qualified Elm.Compiler.Type.Extract as Extract

27−import qualified Elm.Package as Package

28

27

29

28

30-- EXPOSED TYPES

29-- EXPOSED TYPES

@@ -32,33 +31,11 @@ import qualified Elm.Package as Package

32type Interface = Module.Interface

31type Interface = Module.Interface

33

32

34

33

35−newtype Name = Name [String]

34+type Interfaces = Module.Interfaces

36− deriving (Eq, Ord)

37−

38−data CanonicalName =

39− CanonicalName

40− { canonPkg :: Package.Name

41− , canonVersion :: Package.Version

42− , canonModul :: Name

43− } deriving (Eq, Ord)

44−

45−

46−canonFromPackage :: Package.Package -> Name -> CanonicalName

47−canonFromPackage (pk, vr) nm =

48− CanonicalName pk vr nm

49−

50

35

51−fromCanonicalName :: CanonicalName -> Module.CanonicalName

52−fromCanonicalName (CanonicalName p _ (Name n)) =

53− Module.CanonicalName p n

54

36

55−

37+newtype Name = Name ModuleName.Raw

56−canonicalName :: Package.Name -> Package.Version -> Name -> CanonicalName

38+ deriving (Eq, Ord)

57−canonicalName = CanonicalName

58−

59−

60−name :: [String] -> Name

61−name = Name

62

39

63

40

64defaultImports :: [Name]

41defaultImports :: [Name]

src/Elm/Package.hs+14−15

@@ -1,8 +1,6 @@

1−{-# LANGUAGE FlexibleContexts #-}

2module Elm.Package where

1module Elm.Package where

3

2

4import Control.Applicative ((<$>), (<*>))

3import Control.Applicative ((<$>), (<*>))

5−import Control.Monad.Error.Class (MonadError, throwError)

6import Data.Aeson

4import Data.Aeson

7import Data.Binary

5import Data.Binary

8import qualified Data.List as List

6import qualified Data.List as List

@@ -12,11 +10,14 @@ import System.FilePath ((</>))

12import Data.Char (isDigit)

10import Data.Char (isDigit)

13import Data.Function (on)

11import Data.Function (on)

14

12

13+

14+-- PACKGE NAMES

15+

15data Name = Name

16data Name = Name

16 { user :: String

17 { user :: String

17 , project :: String

18 , project :: String

18 }

19 }

19− deriving (Eq, Ord)

20+ deriving (Eq, Ord, Show)

20

21

22

22type Package = (Name, Version)

23type Package = (Name, Version)

@@ -55,11 +56,6 @@ fromString string =

55 _ -> Nothing

56 _ -> Nothing

56

57

58

58−fromString' :: (MonadError String m) => String -> m Name

59−fromString' string =

60− Maybe.maybe (throwError $ errorMsg string) return (fromString string)

61−

62−

63instance Binary Name where

59instance Binary Name where

64 get = Name <$> get <*> get

60 get = Name <$> get <*> get

65 put (Name user project) =

61 put (Name user project) =

@@ -69,10 +65,13 @@ instance Binary Name where

69

65

70instance FromJSON Name where

66instance FromJSON Name where

71 parseJSON (String text) =

67 parseJSON (String text) =

68+ let

72− let string = T.unpack text in

69+ string = T.unpack text

70+ in

73− Maybe.maybe (fail $ errorMsg string) return (fromString string)

71+ Maybe.maybe (fail (errorMsg string)) return (fromString string)

74

72

73+ parseJSON _ =

75− parseJSON _ = fail "Project name must be a string."

74+ fail "Project name must be a string."

76

75

77

76

78instance ToJSON Name where

77instance ToJSON Name where

@@ -88,12 +87,12 @@ errorMsg string =

88 ]

87 ]

89

88

90

89

91−

90+-- PACKAGE VERSIONS

92

91

93data Version = Version

92data Version = Version

94− { major :: Int

93+ { _major :: Int

95− , minor :: Int

94+ , _minor :: Int

96− , patch :: Int

95+ , _patch :: Int

97 }

96 }

98 deriving (Eq, Ord)

97 deriving (Eq, Ord)

99

98

src/Generate/JavaScript.hs+7−107

@@ -6,19 +6,16 @@ import Control.Monad.State

6import qualified Data.List as List

7import qualified Data.Map as Map

8import qualified Data.Maybe as Maybe

9−import qualified Data.Set as Set

10−import Language.ECMAScript3.PrettyPrint

11import Language.ECMAScript3.Syntax

9import Language.ECMAScript3.Syntax

12

10

13−import AST.Module

14import AST.Expression.General as Expr

11import AST.Expression.General as Expr

15import qualified AST.Expression.Optimized as Opt

12import qualified AST.Expression.Optimized as Opt

16import qualified AST.Helpers as Help

13import qualified AST.Helpers as Help

17import AST.Literal

14import AST.Literal

18import qualified AST.Module as Module

15import qualified AST.Module as Module

16+import qualified AST.Module.Name as ModuleName

19import qualified AST.Pattern as P

17import qualified AST.Pattern as P

20import qualified AST.Variable as Var

18import qualified AST.Variable as Var

21−import Elm.Utils ((|>))

22import Generate.JavaScript.Helpers as Help

19import Generate.JavaScript.Helpers as Help

23import qualified Generate.JavaScript.Crash as Crash

20import qualified Generate.JavaScript.Crash as Crash

24import qualified Generate.JavaScript.Port as Port

21import qualified Generate.JavaScript.Port as Port

@@ -28,20 +25,12 @@ import qualified Reporting.Annotation as A

28import qualified Reporting.Crash as Crash

25import qualified Reporting.Crash as Crash

29

26

30

27

31−-- HELPERS

28+generate :: Module.Optimized -> String

29+generate modul =

30+ error "TODO" modul exprToCode

32

31

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

44

32

33+-- HELPERS

45

34

46_Utils :: String -> Expression ()

35_Utils :: String -> Expression ()

47_Utils x =

36_Utils x =

@@ -419,9 +408,6 @@ crushIfsHelp visitedBranches unvisitedBranches finally =

419 (A.A _ (Literal (Boolean True)), branch) : _ ->

408 (A.A _ (Literal (Boolean True)), branch) : _ ->

420 crushIfsHelp visitedBranches [] branch

409 crushIfsHelp visitedBranches [] branch

421

410

422− (A.A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), branch) : _ ->

423− crushIfsHelp visitedBranches [] branch

424−

425 visiting : unvisited ->

411 visiting : unvisited ->

426 crushIfsHelp (visiting : visitedBranches) unvisited finally

412 crushIfsHelp (visiting : visitedBranches) unvisited finally

427

413

@@ -597,92 +583,6 @@ flattenLets defs lexpr@(A.A _ expr) =

597 _ -> (defs, lexpr)

583 _ -> (defs, lexpr)

598

584

599

585

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−

686-- BINARY OPERATORS

586-- BINARY OPERATORS

687

587

688binop

588binop

@@ -753,7 +653,7 @@ backwardApply =

753

653

754inBasics :: String -> Var.Canonical

654inBasics :: String -> Var.Canonical

755inBasics name =

655inBasics name =

756− Var.Canonical (Var.Module ["Basics"]) name

656+ Var.inCore ["Basics"] name

757

657

758

658

759-- BINARY OPERATOR HELPERS

659-- BINARY OPERATOR HELPERS

@@ -764,7 +664,7 @@ makeExpr qualifiedOp@(Var.Canonical home op) =

764 simpleMake left right =

664 simpleMake left right =

765 ref "A2" `call` [ Var.canonical qualifiedOp, left, right ]

665 ref "A2" `call` [ Var.canonical qualifiedOp, left, right ]

766 in

666 in

767− if home == Var.Module ["Basics"] then

667+ if home == Var.Module (ModuleName.inCore ["Basics"]) then

768 Map.findWithDefault simpleMake op basicOps

668 Map.findWithDefault simpleMake op basicOps

769 else

669 else

770 simpleMake

670 simpleMake

src/Generate/JavaScript/Variable.hs+37−20

@@ -1,13 +1,15 @@

1module Generate.JavaScript.Variable where

2

3−import qualified AST.Helpers as Help

4−import qualified AST.Module as Module

5−import qualified AST.Variable as Var

6import qualified Data.List as List

3import qualified Data.List as List

7import qualified Data.Set as Set

4import qualified Data.Set as Set

8−import qualified Generate.JavaScript.Helpers as JS

9import qualified Language.ECMAScript3.Syntax as JS

5import qualified Language.ECMAScript3.Syntax as JS

10

6

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+

11

13

12swap :: Char -> Char -> Char -> Char

14swap :: Char -> Char -> Char -> Char

13swap from to c =

15swap from to c =

@@ -16,21 +18,36 @@ swap from to c =

16

18

17canonical :: Var.Canonical -> JS.Expression ()

19canonical :: Var.Canonical -> JS.Expression ()

18canonical (Var.Canonical home name) =

20canonical (Var.Canonical home name) =

19− case Help.isOp name of

21+ if Help.isOp name then

20− True -> JS.BracketRef () (JS.obj (home' ++ ["_op"])) (JS.string name)

22+ JS.BracketRef () (JS.ref (addRoot home "_op")) (JS.string name)

23+

24+ else

21− False -> JS.obj (home' ++ [ varName name ])

25+ JS.ref (addRoot home (varName name))

22− where

26+

27+

28+addRoot :: Var.Home -> String -> String

23− home' =

29+addRoot home name =

24− case home of

30+ case home of

25− Var.Local -> []

31+ Var.Local ->

32+ name

33+

26− Var.TopLevel _ -> []

34+ Var.TopLevel moduleName ->

35+ canonicalName moduleName name

36+

27− Var.BuiltIn -> []

37+ Var.BuiltIn ->

28− Var.Module path -> [ moduleName path ]

38+ name

39+

40+ Var.Module moduleName ->

41+ canonicalName moduleName name

42+

29

43

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

30

50

31−moduleName :: Module.Name -> String

32−moduleName name =

33− '$' : List.intercalate "$" name

34

51

35

52

36varName :: String -> String

53varName :: String -> String

@@ -41,9 +58,9 @@ varName name =

41 map (swap '\'' '$') saferName

58 map (swap '\'' '$') saferName

42

59

43

60

44−value :: Module.Name -> String -> JS.Expression ()

61+--value :: Module.Name -> String -> JS.Expression ()

45−value home name =

62+--value home name =

46− canonical (Var.Canonical (Var.Module home) name)

63+-- canonical (Var.Canonical (Var.Module home) name)

47

64

48

65

49jsReserveds :: Set.Set String

66jsReserveds :: Set.Set String

src/Nitpick/PatternMatches.hs+3−2

@@ -11,6 +11,7 @@ import qualified AST.Expression.General as E

11import qualified AST.Expression.Canonical as Canonical

12import qualified AST.Helpers as Help

13import qualified AST.Module as Module

14+import qualified AST.Module.Name as ModuleName

14import qualified AST.Pattern as Pattern

15import qualified AST.Pattern as Pattern

15import qualified AST.Variable as Var

16import qualified AST.Variable as Var

16import Elm.Utils ((|>))

17import Elm.Utils ((|>))

@@ -27,7 +28,7 @@ patternMatches

27 -> Result.Result Warning.Warning e ()

28 -> Result.Result Warning.Warning e ()

28patternMatches interfaces modul =

29patternMatches interfaces modul =

29 let

30 let

30− name = Module.names modul

31+ name = Module.name modul

31 body = Module.body modul

32 body = Module.body modul

32 in

33 in

33 checkExpression

34 checkExpression

@@ -44,7 +45,7 @@ type TagDict =

44type Tag = String

45type Tag = String

45

46

47

47−toTagDict :: Module.Interfaces -> Module.Name -> Module.ADTs -> TagDict

48+toTagDict :: Module.Interfaces -> ModuleName.Canonical -> Module.ADTs -> TagDict

48toTagDict interfaces localName localAdts =

49toTagDict interfaces localName localAdts =

49 let

50 let

50 listTags =

51 listTags =

src/Nitpick/TopLevelTypes.hs+49−29

@@ -7,9 +7,11 @@ import qualified Data.Map as Map

7

8import qualified AST.Expression.Valid as Valid

9import qualified AST.Declaration as Decl

10+import qualified AST.Module.Name as ModuleName

10import qualified AST.Pattern as P

11import qualified AST.Pattern as P

11import qualified AST.Type as Type

12import qualified AST.Type as Type

12import qualified AST.Variable as Var

13import qualified AST.Variable as Var

14+import qualified Elm.Package as Pkg

13import qualified Reporting.Annotation as A

15import qualified Reporting.Annotation as A

14import qualified Reporting.Error.Type as Error

16import qualified Reporting.Error.Type as Error

15import qualified Reporting.Result as Result

17import qualified Reporting.Result as Result

@@ -77,39 +79,57 @@ validMainTypes =

77 , signal element

79 , signal element

78 , signal html

80 , signal html

79 ]

81 ]

80− where

81− fromModule :: [String] -> String -> Type.Canonical

82− fromModule home name =

83− Type.Type (Var.fromModule home name)

84

82

85− html =

86− fromModule ["VirtualDom"] "Node"

87

83

88− signal tipe =

84+html :: Type.Canonical

85+html =

89− Type.App (fromModule ["Signal"] "Signal") [ tipe ]

86+ Type.Type (Var.fromModule virtualDom "Node")

90

87

91− element =

92− let builtin name =

93− Type.Type (Var.builtin name)

94

88

95− maybe tipe =

89+virtualDom :: ModuleName.Canonical

96− Type.App (fromModule ["Maybe"] "Maybe") [ tipe ]

90+virtualDom =

97− in

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",

98 Type.Record

99 Type.Record

99− [ ("element", fromModule ["Graphics","Element"] "ElementPrim")

100− , ("props",

101− Type.Record

102− [ ("click" , builtin "_Tuple0")

100+ [ ("click" , builtin "_Tuple0")

103− , ("color" , maybe (fromModule ["Color"] "Color"))

101+ , ("color" , maybe (core ["Color"] "Color"))

104− , ("height" , builtin "Int")

102+ , ("height" , builtin "Int")

105− , ("hover" , builtin "_Tuple0")

103+ , ("hover" , builtin "_Tuple0")

106− , ("href" , builtin "String")

104+ , ("href" , builtin "String")

107− , ("id" , builtin "Int")

105+ , ("id" , builtin "Int")

108− , ("opacity", builtin "Float")

106+ , ("opacity", builtin "Float")

109− , ("tag" , builtin "String")

107+ , ("tag" , builtin "String")

110− , ("width" , builtin "Int")

108+ , ("width" , builtin "Int")

111− ]

112− Nothing

113− )

114 ]

109 ]

115 Nothing

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

5

6import Parse.Helpers

7import qualified AST.Module as Module

8+import qualified AST.Module.Name as ModuleName

8import qualified AST.Variable as Var

9import qualified AST.Variable as Var

9import Reporting.Annotation as A

10import Reporting.Annotation as A

10

11

@@ -12,13 +13,16 @@ import Reporting.Annotation as A

12getModuleName :: String -> Maybe String

13getModuleName :: String -> Maybe String

13getModuleName source =

14getModuleName source =

14 case iParse getModuleName source of

15 case iParse getModuleName source of

15− Right name -> Just name

16+ Right name ->

17+ Just name

18+

19+ Left _ ->

16− Left _ -> Nothing

20+ Nothing

17 where

21 where

18 getModuleName =

22 getModuleName =

19 do optional freshLine

23 do optional freshLine

20 (names, _) <- moduleDecl

24 (names, _) <- moduleDecl

21− return (Module.nameToString names)

25+ return (ModuleName.toString names)

22

26

23

27

24header :: IParser (Module.Header [Module.UserImport])

28header :: IParser (Module.Header [Module.UserImport])

@@ -60,7 +64,7 @@ import' =

60 do try (reserved "import")

64 do try (reserved "import")

61 whitespace

65 whitespace

62 names <- dotSep1 capVar

66 names <- dotSep1 capVar

63− (,) names <$> method (Module.nameToString names)

67+ (,) names <$> method (ModuleName.toString names)

64 where

68 where

65 method :: String -> IParser Module.ImportMethod

69 method :: String -> IParser Module.ImportMethod

66 method defaultAlias =

70 method defaultAlias =

src/Parse/Parse.hs+19−10

@@ -9,7 +9,9 @@ import qualified Text.Parsec.Error as Parsec

9

10import qualified AST.Declaration as D

11import qualified AST.Module as M

12+import qualified AST.Module.Name as ModuleName

12import qualified Elm.Compiler.Imports as Imports

13import qualified Elm.Compiler.Imports as Imports

14+import qualified Elm.Package as Package

13import Parse.Helpers

15import Parse.Helpers

14import qualified Parse.Module as Module

16import qualified Parse.Module as Module

15import qualified Parse.Declaration as Decl

17import qualified Parse.Declaration as Decl

@@ -20,33 +22,40 @@ import qualified Validate

20

22

21

23

22program

24program

23− :: Bool

25+ :: Package.Name

24 -> Bool

26 -> Bool

25 -> OpTable

27 -> OpTable

26 -> String

28 -> String

27 -> Result.Result wrn Error.Error M.ValidModule

29 -> Result.Result wrn Error.Error M.ValidModule

28−program needsDefaults isRoot table src =

30+program pkgName isRoot table src =

29− do (M.Module names filePath docs exports imports sourceDecls) <-

31+ do (M.Module name filePath docs exports imports sourceDecls) <-

30− parseWithTable table src programParser

32+ parseWithTable table src (programParser pkgName)

31

33

32 validDecls <- Validate.declarations isRoot sourceDecls

34 validDecls <- Validate.declarations isRoot sourceDecls

33

35

36+ -- determine if default imports should be added, only elm-lang/core is exempt

34 let ammendedImports =

37 let ammendedImports =

35− (if needsDefaults then Imports.defaults else [], imports)

38+ ( if pkgName == Package.coreName then [] else Imports.defaults

39+ , imports

40+ )

36

41

37− return (M.Module names filePath docs exports ammendedImports validDecls)

42+ return (M.Module name filePath docs exports ammendedImports validDecls)

38

43

39

44

40-- HEADERS AND DECLARATIONS

45-- HEADERS AND DECLARATIONS

41

46

42−programParser :: IParser M.SourceModule

47+programParser :: Package.Name -> IParser M.SourceModule

43−programParser =

48+programParser pkgName =

44− do (M.Header names docs exports imports) <- Module.header

49+ do (M.Header name docs exports imports) <- Module.header

45 decls <- declarations

50 decls <- declarations

46 optional freshLine

51 optional freshLine

47 optional spaces

52 optional spaces

48 eof

53 eof

54+

55+ let canonicalName =

56+ ModuleName.Canonical pkgName name

57+

49− return $ M.Module names "" docs exports imports decls

58+ return $ M.Module canonicalName "" docs exports imports decls

50

59

51

60

52declarations :: IParser [D.SourceDecl]

61declarations :: IParser [D.SourceDecl]

src/Reporting/Error/Canonicalize.hs+8−8

@@ -3,7 +3,7 @@ module Reporting.Error.Canonicalize where

3

4import qualified Text.PrettyPrint as P

5

6−import qualified AST.Module as Module

6+import qualified AST.Module.Name as ModuleName

7import qualified AST.Type as Type

8import qualified AST.Variable as Var

9import qualified Reporting.Error.Helpers as Help

@@ -16,7 +16,7 @@ data Error

16 = Var VarError

17 | Pattern PatternError

18 | Alias AliasError

19− | Import Module.Name ImportError

19+ | Import ModuleName.Raw ImportError

20 | Export String [String]

21 | DuplicateExport String

22 | Port PortError

@@ -58,16 +58,16 @@ argMismatch name expected actual =

58-- IMPORTS

59

60data ImportError

61− = ModuleNotFound [Module.Name]

61+ = ModuleNotFound [ModuleName.Raw]

62 | ValueNotFound String [String]

63

64

65−moduleNotFound :: Module.Name -> [Module.Name] -> Error

65+moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error

66moduleNotFound name possibilities =

67 Import name (ModuleNotFound possibilities)

68

69

70−valueNotFound :: Module.Name -> String -> [String] -> Error

70+valueNotFound :: ModuleName.Raw -> String -> [String] -> Error

71valueNotFound name value possibilities =

72 Import name (ValueNotFound value possibilities)

73

@@ -178,13 +178,13 @@ toReport dealiaser err =

178 ++ "line " ++ show (Region.line start)

179

180 Import name importError ->

181− let moduleName = Module.nameToString name

181+ let moduleName = ModuleName.toString name

182 in

183 case importError of

184 ModuleNotFound suggestions ->

185 namingError

186 ("Could not find a module named `" ++ moduleName ++ "`")

187− (Help.maybeYouWant (map Module.nameToString suggestions))

187+ (Help.maybeYouWant (map ModuleName.toString suggestions))

188

189 ValueNotFound value suggestions ->

190 namingError

@@ -249,7 +249,7 @@ extractSuggestions err =

249 Import _ importError ->

250 case importError of

251 ModuleNotFound suggestions ->

252− Just (map Module.nameToString suggestions)

252+ Just (map ModuleName.toString suggestions)

253

254 ValueNotFound _ suggestions ->

255 Just suggestions

src/Reporting/Warning.hs+3−3

@@ -7,7 +7,7 @@ import qualified Data.Aeson as Json

7import qualified Text.PrettyPrint as P

8import Text.PrettyPrint ((<+>))

9

10−import qualified AST.Module as Module

10+import qualified AST.Module.Name as ModuleName

11import qualified AST.Type as Type

12import qualified Nitpick.Pattern as Pattern

13import qualified Reporting.Annotation as A

@@ -18,7 +18,7 @@ import qualified Reporting.Report as Report

18-- ALL POSSIBLE WARNINGS

19

20data Warning

21− = UnusedImport Module.Name

21+ = UnusedImport ModuleName.Raw

22 | MissingTypeAnnotation String Type.Canonical

23 | InexhaustivePatternMatch [Pattern.Pattern]

24 | RedundantPatternMatch

@@ -42,7 +42,7 @@ toReport dealiaser warning =

42 UnusedImport moduleName ->

43 Report.simple

44 "unused import"

45− ("Module `" ++ Module.nameToString moduleName ++ "` is unused.")

45+ ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")

46 ""

47

48 MissingTypeAnnotation name inferredType ->

src/Type/Inference.hs+28−21

@@ -6,6 +6,7 @@ import qualified Data.Map as Map

6import qualified Data.Traversable as Traverse

7

8import AST.Module as Module

9+import qualified AST.Module.Name as ModuleName

9import qualified AST.Type as Type

10import qualified AST.Type as Type

10import qualified AST.Variable as Var

11import qualified AST.Variable as Var

11import qualified Reporting.Annotation as A

12import qualified Reporting.Annotation as A

@@ -22,7 +23,7 @@ import System.IO.Unsafe

22

23

24

24infer

25infer

25− :: CanonicalInterfaces

26+ :: Module.Interfaces

26 -> Module.CanonicalModule

27 -> Module.CanonicalModule

27 -> Except [A.Located Error.Error] (Map.Map String Type.Canonical)

28 -> Except [A.Located Error.Error] (Map.Map String Type.Canonical)

28infer interfaces modul =

29infer interfaces modul =

@@ -39,7 +40,7 @@ infer interfaces modul =

39

40

41

41genConstraints

42genConstraints

42− :: CanonicalInterfaces

43+ :: Module.Interfaces

43 -> Module.CanonicalModule

44 -> Module.CanonicalModule

44 -> IO (Env.TypeDict, T.TypeConstraint)

45 -> IO (Env.TypeDict, T.TypeConstraint)

45genConstraints interfaces modul =

46genConstraints interfaces modul =

@@ -69,34 +70,40 @@ genConstraints interfaces modul =

69

70

70canonicalizeValues

71canonicalizeValues

71 :: Env.Environment

72 :: Env.Environment

72− -> (Module.CanonicalName, Interface)

73+ -> (ModuleName.Canonical, Interface)

73 -> IO [(String, ([T.Variable], T.Type))]

74 -> IO [(String, ([T.Variable], T.Type))]

74canonicalizeValues env (moduleName, iface) =

75canonicalizeValues env (moduleName, iface) =

75 forM (Map.toList (iTypes iface)) $ \(name,tipe) ->

76 forM (Map.toList (iTypes iface)) $ \(name,tipe) ->

76 do tipe' <- Env.instantiateType env tipe Map.empty

77 do tipe' <- Env.instantiateType env tipe Map.empty

77− return ((Module.nameToString $ Module.canonModul moduleName) ++ "." ++ name, tipe')

78+ return

79+ ( ModuleName.canonicalToString moduleName ++ "." ++ name

80+ , tipe'

81+ )

78

82

79

83

80−canonicalizeAdts :: CanonicalInterfaces -> Module.CanonicalModule -> [CanonicalAdt]

84+canonicalizeAdts :: Module.Interfaces -> Module.CanonicalModule -> [CanonicalAdt]

81canonicalizeAdts interfaces modul =

85canonicalizeAdts interfaces modul =

82 localAdts ++ importedAdts

86 localAdts ++ importedAdts

83 where

87 where

84 localAdts :: [CanonicalAdt]

88 localAdts :: [CanonicalAdt]

89+ localAdts =

85− localAdts = format (Module.names modul, datatypes (body modul))

90+ format (Module.name modul, datatypes (body modul))

86

91

87 importedAdts :: [CanonicalAdt]

92 importedAdts :: [CanonicalAdt]

93+ importedAdts =

88− importedAdts = concatMap (format . second iAdts)

94+ concatMap (format . second iAdts) (Map.toList interfaces)

89− (map (\(nm, iface) -> (Module.canonModul nm, iface )) $ Map.toList $ interfaces)

95+

90−

96+

91− format :: (Module.Name, Module.ADTs) -> [CanonicalAdt]

97+format :: (ModuleName.Canonical, Module.ADTs) -> [CanonicalAdt]

92− format (home, adts) =

98+format (home, adts) =

93− map canonical (Map.toList adts)

99+ map canonical (Map.toList adts)

94− where

100+ where

95− canonical :: (String, AdtInfo String) -> CanonicalAdt

101+ canonical :: (String, AdtInfo String) -> CanonicalAdt

96− canonical (name, (tvars, ctors)) =

102+ canonical (name, (tvars, ctors)) =

97− ( toVar name

103+ ( toVar name

98− , (tvars, map (first toVar) ctors)

104+ , (tvars, map (first toVar) ctors)

99− )

105+ )

100−

106+

101− toVar :: String -> Var.Canonical

107+ toVar :: String -> Var.Canonical

102− toVar = Var.Canonical (Var.Module home)

108+ toVar name =

109+ Var.fromModule home name