14ef71a · elk · git.iko.soy

Elm.cabal+2

compare with master

unifiedsplit

@@ -66,6 +66,7 @@ Library

66 Transform.Expression,

67 Transform.Declaration,

68 Transform.Definition,

69+ Transform.Interface,

69 Transform.SortDefinitions,

70 Transform.SortDefinitions,

70 Transform.Substitute,

71 Transform.Substitute,

71 Metadata.Prelude,

72 Metadata.Prelude,

@@ -156,6 +157,7 @@ Executable elm

156 Transform.Expression,

157 Transform.Expression,

157 Transform.Declaration,

158 Transform.Declaration,

158 Transform.Definition,

159 Transform.Definition,

160+ Transform.Interface,

159 Transform.SortDefinitions,

161 Transform.SortDefinitions,

160 Transform.Substitute,

162 Transform.Substitute,

161 Metadata.Prelude,

163 Metadata.Prelude,

compiler/AST/Module.hs+4−1

@@ -52,6 +52,7 @@ type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)

52

53data Interface = Interface

54 { iVersion :: Version.Version

55+ , iExports :: [Var.Value]

55 , iTypes :: Types

56 , iTypes :: Types

56 , iImports :: [(String, ImportMethod)]

57 , iImports :: [(String, ImportMethod)]

57 , iAdts :: ADTs

58 , iAdts :: ADTs

@@ -65,6 +66,7 @@ toInterface modul =

65 let body' = body modul in

66 let body' = body modul in

66 Interface

67 Interface

67 { iVersion = Version.elmVersion

68 { iVersion = Version.elmVersion

69+ , iExports = exports modul

68 , iTypes = types body'

70 , iTypes = types body'

69 , iImports = imports modul

71 , iImports = imports modul

70 , iAdts = datatypes body'

72 , iAdts = datatypes body'

@@ -74,9 +76,10 @@ toInterface modul =

74 }

76 }

75

77

76instance Binary Interface where

78instance Binary Interface where

77− get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get

79+ get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

78 put modul = do

80 put modul = do

79 put (iVersion modul)

81 put (iVersion modul)

82+ put (iExports modul)

80 put (iTypes modul)

83 put (iTypes modul)

81 put (iImports modul)

84 put (iImports modul)

82 put (iAdts modul)

85 put (iAdts modul)

compiler/Build/Source.hs+2−3

@@ -29,8 +29,7 @@ build noPrelude interfaces source =

29 -- Run type inference on the program.

30 types <- TI.infer interfaces canonicalModule

31

32− -- Trim down the set of exported values to the stuff that is actually exported.

32+ -- Add the real list of tyes

33− let bodyWithTypes = (Module.body canonicalModule) { Module.types = types }

33+ let body = (Module.body canonicalModule) { Module.types = types }

34− body = Canonical.filterExports bodyWithTypes (Module.exports canonicalModule)

35

34

36 return $ canonicalModule { Module.body = body }

35 return $ canonicalModule { Module.body = body }

compiler/Transform/Canonicalize.hs+1−48

@@ -1,5 +1,5 @@

1{-# OPTIONS_GHC -W #-}

2−module Transform.Canonicalize (module', filterExports) where

2+module Transform.Canonicalize (module') where

3

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

5import Control.Monad.Error (runErrorT, throwError)

@@ -106,53 +106,6 @@ delist fullList (Var.Listing partial open)

106

107 _ -> go list xs partial

108

109−filterExports :: Module.CanonicalBody -> [Var.Value] -> Module.CanonicalBody

110−filterExports body exportedValues =

111− body

112− { Module.types =

113− Map.fromList (concatMap getTypes exportedValues)

114− , Module.aliases =

115− Map.fromList (concatMap getAliases exportedValues)

116− , Module.datatypes =

117− Map.fromList (concatMap getAdts exportedValues)

118− }

119− where

120− get :: Map.Map String a -> String -> [(String, a)]

121− get dict x =

122− case Map.lookup x dict of

123− Just t -> [(x,t)]

124− Nothing -> []

125−

126− getTypes :: Var.Value -> [(String, Type.CanonicalType)]

127− getTypes value =

128− case value of

129− Var.Value x -> getType x

130− Var.Alias _ -> []

131− Var.ADT _ (Var.Listing ctors _) -> concatMap getType ctors

132−

133− getType :: String -> [(String, Type.CanonicalType)]

134− getType = get (Module.types body)

135−

136− getAliases :: Var.Value -> [(String, ([String], Type.CanonicalType))]

137− getAliases value =

138− case value of

139− Var.Value _ -> []

140− Var.Alias name -> get (Module.aliases body) name

141− Var.ADT _ _ -> []

142−

143− getAdts :: Var.Value -> [(String, Module.AdtInfo String)]

144− getAdts value =

145− case value of

146− Var.Value _ -> []

147− Var.Alias _ -> []

148− Var.ADT name (Var.Listing exportedCtors _) ->

149− case Map.lookup name (Module.datatypes body) of

150− Nothing -> []

151− Just (tvars, ctors) ->

152− [(name, (tvars, filter isExported ctors))]

153− where

154− isExported (ctor, _) = ctor `elem` exportedCtors

155−

156

109

157declToValue :: D.ValidDecl -> [Var.Value]

110declToValue :: D.ValidDecl -> [Var.Value]

158declToValue decl =

111declToValue decl =

compiler/Transform/Canonicalize/Setup.hs+3−2

@@ -21,6 +21,7 @@ import Text.PrettyPrint as P

21

22import Transform.Canonicalize.Environment as Env

23import qualified Transform.Canonicalize.Type as Canonicalize

24+import qualified Transform.Interface as Interface

24

25

25environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment

26environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment

26environment interfaces modul@(Module.Module _ _ _ imports decls) =

27environment interfaces modul@(Module.Module _ _ _ imports decls) =

@@ -48,7 +49,7 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =

48

49

49addImports :: String -> Module.Interfaces -> Environment -> (String, Module.ImportMethod)

50addImports :: String -> Module.Interfaces -> Environment -> (String, Module.ImportMethod)

50 -> Canonicalizer [Doc] Environment

51 -> Canonicalizer [Doc] Environment

51−addImports moduleName interfaces environ (name,method)

52+addImports moduleName interfaces environ (name, method)

52 | List.isPrefixOf "Native." name = return environ

53 | List.isPrefixOf "Native." name = return environ

53 | otherwise =

54 | otherwise =

54 case method of

55 case method of

@@ -59,7 +60,7 @@ addImports moduleName interfaces environ (name,method)

59 | open -> return (updateEnviron "")

60 | open -> return (updateEnviron "")

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

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

61 where

62 where

62− interface = (Map.!) interfaces name

63+ interface = Interface.filterExports ((Map.!) interfaces name)

63

64

64 updateEnviron prefix =

65 updateEnviron prefix =

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

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

compiler/Transform/Interface.hsnew file+57

@@ -0,0 +1,57 @@

1+{-# OPTIONS_GHC -W #-}

2+module Transform.Interface (filterExports) where

3+

4+import qualified Data.Map as Map

5+import qualified AST.Module as Module

6+import qualified AST.Type as Type

7+import qualified AST.Variable as Var

8+

9+filterExports :: Module.Interface -> Module.Interface

10+filterExports interface =

11+ interface

12+ { Module.iTypes =

13+ Map.fromList (concatMap getTypes exportedValues)

14+ , Module.iAliases =

15+ Map.fromList (concatMap getAliases exportedValues)

16+ , Module.iAdts =

17+ Map.fromList (concatMap getAdts exportedValues)

18+ }

19+ where

20+ exportedValues :: [Var.Value]

21+ exportedValues = Module.iExports interface

22+

23+ get :: Map.Map String a -> String -> [(String, a)]

24+ get dict x =

25+ case Map.lookup x dict of

26+ Just t -> [(x,t)]

27+ Nothing -> []

28+

29+ getTypes :: Var.Value -> [(String, Type.CanonicalType)]

30+ getTypes value =

31+ case value of

32+ Var.Value x -> getType x

33+ Var.Alias _ -> []

34+ Var.ADT _ (Var.Listing ctors _) -> concatMap getType ctors

35+

36+ getType :: String -> [(String, Type.CanonicalType)]

37+ getType = get (Module.iTypes interface)

38+

39+ getAliases :: Var.Value -> [(String, ([String], Type.CanonicalType))]

40+ getAliases value =

41+ case value of

42+ Var.Value _ -> []

43+ Var.Alias name -> get (Module.iAliases interface) name

44+ Var.ADT _ _ -> []

45+

46+ getAdts :: Var.Value -> [(String, Module.AdtInfo String)]

47+ getAdts value =

48+ case value of

49+ Var.Value _ -> []

50+ Var.Alias _ -> []

51+ Var.ADT name (Var.Listing exportedCtors _) ->

52+ case Map.lookup name (Module.iAdts interface) of

53+ Nothing -> []

54+ Just (tvars, ctors) ->

55+ [(name, (tvars, filter isExported ctors))]

56+ where

57+ isExported (ctor, _) = ctor `elem` exportedCtors