2234b88 · elk · git.iko.soy

src/AST/Module.hs+39−30

compare with master

unifiedsplit

@@ -1,4 +1,14 @@

1−module AST.Module where

1+module AST.Module

2+ ( Interfaces

3+ , Types, Aliases, ADTs

4+ , AdtInfo, CanonicalAdt

5+ , SourceModule, ValidModule, CanonicalModule

6+ , Module(..), CanonicalBody(..)

7+ , HeaderAndImports(..)

8+ , Name, nameToString, nameIsNative

9+ , Interface(..), toInterface

10+ , ImportMethod(..)

11+ ) where

2

12

3import Data.Binary

13import Data.Binary

4import qualified Data.List as List

14import qualified Data.List as List

@@ -65,10 +75,14 @@ data HeaderAndImports = HeaderAndImports

65 , _imports :: [(Name, ImportMethod)]

75 , _imports :: [(Name, ImportMethod)]

66 }

76 }

67

77

78+

68type Name = [String] -- must be non-empty

79type Name = [String] -- must be non-empty

69

80

81+

70nameToString :: Name -> String

82nameToString :: Name -> String

83+nameToString =

71−nameToString = List.intercalate "."

84+ List.intercalate "."

85+

72

86

73nameIsNative :: Name -> Bool

87nameIsNative :: Name -> Bool

74nameIsNative name =

88nameIsNative name =

@@ -121,27 +135,19 @@ instance Binary Interface where

121

135

122-- IMPORT METHOD

136-- IMPORT METHOD

123

137

124−data ImportMethod

138+data ImportMethod = ImportMethod

125− = As !String

139+ { alias :: Maybe String

126− | Open !(Var.Listing Var.Value)

140+ , exposedVars :: !(Var.Listing Var.Value)

127−

141+ }

128−open :: ImportMethod

129−open = Open (Var.openListing)

130

142

131−importing :: [Var.Value] -> ImportMethod

132−importing xs = Open (Var.Listing xs False)

133

143

134instance Binary ImportMethod where

144instance Binary ImportMethod where

135− put method =

145+ put (ImportMethod alias exposedVars) =

136− case method of

137− As alias -> putWord8 0 >> put alias

146+ do put alias

138− Open listing -> putWord8 1 >> put listing

147+ put exposedVars

139

148

140− get = do tag <- getWord8

149+ get =

141− case tag of

150+ ImportMethod <$> get <*> get

142− 0 -> As <$> get

143− 1 -> Open <$> get

144− _ -> error "Error reading valid ImportMethod type from serialized string"

145

151

146

152

147-- PRETTY PRINTING

153-- PRETTY PRINTING

@@ -150,19 +156,22 @@ instance (Pretty exs, Pretty body) => Pretty (Module exs body) where

150 pretty (Module names _ exs ims body) =

156 pretty (Module names _ exs ims body) =

151 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]

157 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]

152 where

158 where

159+ modul =

153− modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"

160+ P.text "module" <+> name <+> pretty exs <+> P.text "where"

154− name = P.text (List.intercalate "." names)

161+

162+ name =

163+ P.text (nameToString names)

155

164

156 prettyImports =

165 prettyImports =

157− P.vcat $ map prettyMethod ims

166+ P.vcat $ map prettyMethod ims

158

167

159

168

160prettyMethod :: (Name, ImportMethod) -> Doc

169prettyMethod :: (Name, ImportMethod) -> Doc

161−prettyMethod import' =

170+prettyMethod (name, ImportMethod maybeAlias exposedVars) =

171+ let prettyAlias =

162− case import' of

172+ case maybeAlias of

163− ([name], As alias)

164− | name == alias -> P.empty

173+ Nothing -> P.empty

165−

174+ Just alias ->

166− (_, As alias) -> P.text "as" <+> P.text alias

175+ P.text "as" <+> P.text alias

167−

176+ in

168− (_, Open listing) -> pretty listing

177+ prettyAlias <+> pretty exposedVars

src/AST/Variable.hs+10

@@ -126,6 +126,16 @@ openListing =

126 Listing [] True

127

128

129+closedListing :: Listing a

130+closedListing =

131+ Listing [] False

132+

133+

134+listing :: [a] -> Listing a

135+listing xs =

136+ Listing xs False

137+

138+

129-- | A value that can be imported or exported

139-- | A value that can be imported or exported

130data Value

140data Value

131 = Value !String

141 = Value !String

src/Elm/Compiler/Module.hs+1−1

@@ -34,7 +34,7 @@ newtype Name = Name [String]

34

35defaultImports :: [Name]

36defaultImports =

37− map Name (Map.keys Defaults.defaultImports)

37+ map (Name . fst) Defaults.defaultImports

38

39

40-- POKING AROUND INTERFACES

src/Parse/Helpers.hs+1−1

@@ -29,7 +29,7 @@ reserveds =

29 , "let", "in"

30 , "type"

31 , "module", "where"

32− , "import", "as", "hiding", "open"

32+ , "import", "as", "hiding", "exposing"

33 , "export", "foreign"

34 , "deriving", "port"

35 ]

src/Parse/Module.hs+19−14

@@ -1,7 +1,6 @@

1module Parse.Module (header, headerAndImports, getModuleName) where

2

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

4−import Data.List (intercalate)

5import Text.Parsec hiding (newline, spaces)

4import Text.Parsec hiding (newline, spaces)

6

5

7import Parse.Helpers

6import Parse.Helpers

@@ -18,7 +17,7 @@ getModuleName source =

18 getModuleName =

17 getModuleName =

19 do optional freshLine

18 do optional freshLine

20 (names, _) <- header

19 (names, _) <- header

21− return (intercalate "." names)

20+ return (Module.nameToString names)

22

21

23

22

24headerAndImports :: IParser Module.HeaderAndImports

23headerAndImports :: IParser Module.HeaderAndImports

@@ -52,19 +51,25 @@ import' =

52 do try (reserved "import")

51 do try (reserved "import")

53 whitespace

52 whitespace

54 names <- dotSep1 capVar

53 names <- dotSep1 capVar

55− (,) names <$> option (Module.As (intercalate "." names)) method

54+ (,) names <$> method (Module.nameToString names)

56 where

55 where

57− method :: IParser Module.ImportMethod

56+ method :: String -> IParser Module.ImportMethod

58− method = as' <|> importing'

57+ method defaultAlias =

59−

58+ Module.ImportMethod

59+ <$> option (Just defaultAlias) (Just <$> as')

60+ <*> option Var.closedListing exposing

61+

60− as' :: IParser Module.ImportMethod

62+ as' :: IParser String

61− as' = do

63+ as' =

62− try (whitespace >> reserved "as")

64+ do try (whitespace >> reserved "as")

63− whitespace

65+ whitespace

64− Module.As <$> capVar <?> "alias for module"

66+ capVar <?> "alias for module"

65−

67+

66− importing' :: IParser Module.ImportMethod

68+ exposing :: IParser (Var.Listing Var.Value)

69+ exposing =

70+ do try (whitespace >> reserved "exposing")

71+ whitespace

67− importing' = Module.Open <$> listing value

72+ listing value

68

73

69

74

70listing :: IParser a -> IParser (Var.Listing a)

75listing :: IParser a -> IParser (Var.Listing a)

src/Transform/AddDefaultImports.hs+12−62

@@ -1,47 +1,28 @@

1−{-# LANGUAGE FlexibleContexts #-}

2module Transform.AddDefaultImports (add, defaultImports) where

1module Transform.AddDefaultImports (add, defaultImports) where

3

2

4−import Prelude hiding (maybe)

5−import qualified Data.Map as Map

6−

7import qualified AST.Module as Module

3import qualified AST.Module as Module

8import qualified AST.Variable as Var

4import qualified AST.Variable as Var

9

5

10

6

11−type ImportDict =

12− Map.Map Module.Name ([String], Var.Listing Var.Value)

13−

14−

15-- DESCRIPTION OF DEFAULT IMPORTS

7-- DESCRIPTION OF DEFAULT IMPORTS

16

8

17(==>) :: a -> b -> (a,b)

9(==>) :: a -> b -> (a,b)

18(==>) = (,)

10(==>) = (,)

19

11

20

12

21−defaultImports :: ImportDict

13+defaultImports :: [(Module.Name, Module.ImportMethod)]

22defaultImports =

14defaultImports =

23− Map.fromList

24− [ ["Basics"] ==> ([], Var.openListing)

15+ [ ["Basics"] ==> Module.ImportMethod Nothing Var.openListing

25− , ["List"] ==> ([], Var.Listing [Var.Value "::"] False)

16+ , ["List"] ==> exposing [Var.Value "::"]

26− , ["Maybe"] ==> ([], Var.Listing [maybe] False)

17+ , ["Maybe"] ==> exposing [Var.Union "Maybe" Var.openListing]

27− , ["Result"] ==> ([], Var.Listing [result] False)

18+ , ["Result"] ==> exposing [Var.Union "Result" Var.openListing]

28− , ["Signal"] ==> ([], Var.Listing [signal] False)

19+ , ["Signal"] ==> exposing [Var.Union "Signal" Var.closedListing]

29 ]

20 ]

30

21

31

22

32−maybe :: Var.Value

23+exposing :: [Var.Value] -> Module.ImportMethod

33−maybe =

24+exposing vars =

34− Var.Union "Maybe" Var.openListing

25+ Module.ImportMethod Nothing (Var.listing vars)

35−

36−

37−result :: Var.Value

38−result =

39− Var.Union "Result" Var.openListing

40−

41−

42−signal :: Var.Value

43−signal =

44− Var.Union "Signal" (Var.Listing [] False)

45

26

46

27

47-- ADDING DEFAULT IMPORTS TO A MODULE

28-- ADDING DEFAULT IMPORTS TO A MODULE

@@ -51,37 +32,6 @@ add needsDefaults (Module.Module moduleName path exports imports decls) =

51 Module.Module moduleName path exports ammendedImports decls

32 Module.Module moduleName path exports ammendedImports decls

52 where

33 where

53 ammendedImports =

34 ammendedImports =

54− importDictToList $

35+ if needsDefaults

55− foldr addImport (if needsDefaults then defaultImports else Map.empty) imports

36+ then defaultImports ++ imports

56−

57−

58−importDictToList :: ImportDict -> [(Module.Name, Module.ImportMethod)]

59−importDictToList dict =

60− concatMap toImports (Map.toList dict)

61− where

62− toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =

63− map (\qualifier -> (name, Module.As qualifier)) qualifiers

64− ++

65− if open || not (null explicits)

66− then [(name, Module.Open listing)]

67− else []

37+ else imports

68−

69−

70−addImport :: (Module.Name, Module.ImportMethod) -> ImportDict -> ImportDict

71−addImport (name, method) importDict =

72− Map.alter mergeMethods name importDict

73− where

74− mergeMethods :: Maybe ([String], Var.Listing Var.Value)

75− -> Maybe ([String], Var.Listing Var.Value)

76− mergeMethods entry =

77− let (qualifiers, listing) =

78− case entry of

79− Nothing -> ([], Var.Listing [] False)

80− Just v -> v

81− in

82− case method of

83− Module.As qualifier ->

84− Just (qualifier : qualifiers, listing)

85−

86− Module.Open newListing ->

87− Just (qualifiers, newListing)

src/Transform/Canonicalize/Setup.hs+17−9

@@ -73,20 +73,26 @@ addImports moduleName interfaces environ (name, method)

73 return environ

74

75 | otherwise =

76− case method of

76+ let (Module.ImportMethod maybeAlias listing) = method

77− Module.As name' ->

78− return (updateEnviron (name' ++ "."))

79

77

80− Module.Open (Var.Listing vs open)

78+ (Var.Listing exposedVars open) = listing

79+

80+ qualifier =

81+ maybe (Module.nameToString name) id maybeAlias

82+

83+ env =

84+ updateEnviron (qualifier ++ ".") environ

85+ in

86+ if open

81− | open -> return (updateEnviron "")

87+ then return (updateEnviron "" env)

82− | otherwise -> foldM (addValue name interface) environ vs

88+ else foldM (addValue name interface) env exposedVars

83 where

89 where

84 interface =

90 interface =

85 Interface.filterExports ((Map.!) interfaces name)

91 Interface.filterExports ((Map.!) interfaces name)

86

92

87− updateEnviron prefix =

93+ updateEnviron prefix env =

88 let dict' = dict . map (first (prefix++)) in

94 let dict' = dict . map (first (prefix++)) in

89− merge environ $

95+ merge env $

90 Env { _home = moduleName

96 Env { _home = moduleName

91 , _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors

97 , _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors

92 , _adts = dict' $ map pair (Map.keys (iAdts interface))

98 , _adts = dict' $ map pair (Map.keys (iAdts interface))

@@ -106,7 +112,9 @@ addImports moduleName interfaces environ (name, method)

106 (x, (canonical x, tvars, tipe))

112 (x, (canonical x, tvars, tipe))

107

113

108 ctors =

114 ctors =

115+ concatMap

116+ (map (pair . fst) . snd . snd)

109− concatMap (map (pair . fst) . snd . snd) (Map.toList (iAdts interface))

117+ (Map.toList (iAdts interface))

110

118

111

119

112addValue

120addValue