70bd232 · elk · git.iko.soy

git.iko.soy/elk

Filter unused modules

Possibly sets things up for warnings on unused imports

commit70bd232a8066d306f1175310f8c02b47b119cd58 authorEvan Czaplicki <info@elm-lang.org> dateTue 3 Jun 2014, 07:12 (12 years ago) parente6ac3d3

8 files changed+99−59

compare with master

unifiedsplit

Elm.cabal+1 compiler/AST/PrettyPrint.hs+4 compiler/Transform/Canonicalize.hs+29−17 compiler/Transform/Canonicalize/Environment.hs+26 compiler/Transform/Canonicalize/Setup.hs+19−19 compiler/Transform/Canonicalize/Type.hs+5−5 compiler/Transform/Canonicalize/Variable.hs+15−14 compiler/Type/Environment.hs−4

Elm.cabal+1

@@ -256,6 +256,7 @@ Executable elm-doc

256256 pretty,

257257 scientific,

258258 text,

259+ transformers >= 0.2,

259260 union-find,

260261 yaml

261262

compiler/AST/PrettyPrint.hs+4

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

11{-# LANGUAGE FlexibleInstances #-}

22module AST.PrettyPrint where

4+import Control.Monad.Trans.Error

45import Text.PrettyPrint as P

56import qualified AST.Helpers as Help

@@ -36,3 +37,6 @@ eightyCharLines indent message = answer

3637 step (sentence, slen, space) (word, wlen)

3738 | slen + wlen > 79 = (sentence ++ "\n" ++ spaces ++ word, indent + wlen, " ")

3839 | otherwise = (sentence ++ space ++ word, slen + wlen + length space, " ")

40+

41+instance ErrorList Doc where

42+ listMsg str = [ P.text str ]

compiler/Transform/Canonicalize.hs+29−17

@@ -2,9 +2,11 @@

22module Transform.Canonicalize (module', filterExports) where

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

5−import qualified Data.Either as Either

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

6+import Control.Monad.State (runState)

67import qualified Data.List as List

78import qualified Data.Map as Map

9+import qualified Data.Set as Set

810import qualified Data.Traversable as T

911

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

@@ -29,7 +31,18 @@ import qualified Transform.SortDefinitions as Transform

2931import qualified Transform.Declaration as Transform

3032

3133module' :: Module.Interfaces -> Module.ValidModule -> Either [Doc] Module.CanonicalModule

32−module' interfaces modul@(Module.Module _ _ exs _ decls) =

34+module' interfaces modul =

35+ filterImports <$> modul'

36+ where

37+ canonicalizer = moduleHelp interfaces modul

38+ (modul', usedModules) = runState (runErrorT canonicalizer) Set.empty

39+ filterImports m =

40+ let used (name,_) = Set.member name usedModules

41+ in m { Module.imports = filter used (Module.imports m) }

42+

43+moduleHelp :: Module.Interfaces -> Module.ValidModule

44+ -> Canonicalizer [Doc] Module.CanonicalModule

45+moduleHelp interfaces modul@(Module.Module _ _ exs _ decls) =

3346 do env <- Setup.environment interfaces modul

3447 canonicalDecls <- mapM (declaration env) decls

3548 exports' <- delist locals exs

@@ -57,15 +70,15 @@ module' interfaces modul@(Module.Module _ _ exs _ decls) =

5770 [ D.portName port | D.Port port <- decls ]

5871 }

5972

60−delist :: [Var.Value] -> Var.Listing Var.Value -> Either [Doc] [Var.Value]

73+delist :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]

6174delist fullList (Var.Listing partial open)

6275 | open = return fullList

6376 | otherwise = go [] (List.sort fullList) (List.sort partial)

6477 where

6578 notFound xs =

66− Left $ [ P.text "Export Error: trying to export non-existent values:" <+>

67− commaSep (map pretty xs)

68− ]

79+ throwError [ P.text "Export Error: trying to export non-existent values:" <+>

80+ commaSep (map pretty xs)

81+ ]

6982

7083 go list full partial =

7184 case (full, partial) of

@@ -123,13 +136,13 @@ declToValue decl =

123136

124137 _ -> []

125138

126−declaration :: Environment -> D.ValidDecl -> Either [Doc] D.CanonicalDecl

139+declaration :: Environment -> D.ValidDecl -> Canonicalizer [Doc] D.CanonicalDecl

127140declaration env decl =

128141 let canonicalize kind context pattern env v =

129− case kind env v of

130− Right v' -> Right v'

131− Left err -> Left [ P.vcat [ ctx, P.text err ] ]

132− where ctx = P.text ("Error in " ++ context) <+> pretty pattern <> P.colon

142+ let ctx = P.text ("Error in " ++ context) <+> pretty pattern <> P.colon

143+ throw err = P.vcat [ ctx, P.text err ]

144+ in

145+ Env.onError throw (kind env v)

133146 in

134147 case decl of

135148 D.Definition (Valid.Definition p e t) ->

@@ -161,14 +174,13 @@ declaration env decl =

161174 D.Fixity assoc prec op -> return $ D.Fixity assoc prec op

162175

163176

164−expression :: Environment -> Valid.Expr -> Either [Doc] Canonical.Expr

177+expression :: Environment -> Valid.Expr -> Canonicalizer [Doc] Canonical.Expr

165178expression env (A.A ann expr) =

166179 let go = expression env

167180 tipe' environ = format . Canonicalize.tipe environ

168− throw err =

169− let msg = P.text "Error" <+> pretty ann <> P.colon

170− in Left [ P.vcat [ msg, P.text err ] ]

171− format = Either.either throw return

181+ throw err = P.vcat [ P.text "Error" <+> pretty ann <> P.colon

182+ , P.text err ]

183+ format = Env.onError throw

172184 in

173185 A.A ann <$>

174186 case expr of

@@ -228,7 +240,7 @@ expression env (A.A ann expr) =

228240

229241 GLShader uid src tipe -> return (GLShader uid src tipe)

230242

231−pattern :: Environment -> P.RawPattern -> Either String P.CanonicalPattern

243+pattern :: Environment -> P.RawPattern -> Canonicalizer String P.CanonicalPattern

232244pattern env ptrn =

233245 case ptrn of

234246 P.Var x -> return $ P.Var x

compiler/Transform/Canonicalize/Environment.hs+26

@@ -2,13 +2,19 @@

22module Transform.Canonicalize.Environment where

44import Control.Arrow (second)

5+import qualified Control.Monad.Error as Error

6+import qualified Control.Monad.State as State

57import qualified Data.Map as Map

8+import qualified Data.Set as Set

710import AST.Expression.General (saveEnvName)

811import qualified AST.Pattern as P

912import qualified AST.Type as Type

1013import qualified AST.Variable as Var

1114

15+import AST.PrettyPrint ()

16+import Text.PrettyPrint (Doc)

17+

1218type Dict a = Map.Map String [a]

1319

1420dict :: [(String,a)] -> Dict a

@@ -17,6 +23,26 @@ dict pairs = Map.fromList $ map (second (:[])) pairs

1723insert :: String -> a -> Dict a -> Dict a

1824insert key value = Map.insertWith (++) key [value]

1925

26+type Canonicalizer err a = Error.ErrorT err (State.State (Set.Set String)) a

27+

28+using :: Var.Canonical -> Canonicalizer String Var.Canonical

29+using var@(Var.Canonical home _) =

30+ do case home of

31+ Var.BuiltIn -> return ()

32+ Var.Module path -> Error.lift (State.modify (Set.insert path))

33+ Var.Local -> return ()

34+ return var

35+

36+onError :: (String -> Doc) -> Canonicalizer String a -> Canonicalizer [Doc] a

37+onError handler canonicalizer =

38+ do usedModules <- Error.lift State.get

39+ let (result, usedModules') =

40+ State.runState (Error.runErrorT canonicalizer) usedModules

41+ Error.lift (State.put usedModules')

42+ case result of

43+ Left err -> Error.throwError [handler err]

44+ Right x -> return x

45+

2046data Environment = Env

2147 { _values :: Dict Var.Canonical

2248 , _adts :: Dict Var.Canonical

compiler/Transform/Canonicalize/Setup.hs+19−19

@@ -3,7 +3,7 @@ module Transform.Canonicalize.Setup (environment) where

44import Control.Arrow (first)

55import Control.Monad (foldM)

6−import qualified Data.Either as Either

6+import Control.Monad.Error (throwError)

77import qualified Data.Graph as Graph

88import qualified Data.List as List

99import qualified Data.Map as Map

@@ -22,7 +22,7 @@ import Text.PrettyPrint as P

2222import Transform.Canonicalize.Environment as Env

2323import qualified Transform.Canonicalize.Type as Canonicalize

2424

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

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

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

2727 do () <- allImportsAvailable

2828 nonLocalEnv <- foldM (addImports interfaces) builtIns imports

@@ -30,11 +30,11 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =

3030 (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls

3131 addTypeAliases moduleName aliases env

3232 where

33− allImportsAvailable :: Either [Doc] ()

33+ allImportsAvailable :: Canonicalizer [Doc] ()

3434 allImportsAvailable =

3535 case filter (not . found) modules of

36− [] -> Right ()

37− missings -> Left [ P.text (missingModuleError missings) ]

36+ [] -> return ()

37+ missings -> throwError [ P.text (missingModuleError missings) ]

3838 where

3939 modules = map fst imports

4040

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

4747 , "flag to detect modules you have written." ]

4848

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

50− -> Either [Doc] Environment

50+ -> Canonicalizer [Doc] Environment

5151addImports interfaces environ (name,method)

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

5353 | otherwise =

@@ -81,12 +81,12 @@ addImports interfaces environ (name,method)

8181 ctors = concatMap (map (pair . fst) . snd . snd) (Map.toList (iAdts interface))

8282

8383addValue :: String -> Module.Interface -> Environment -> Var.Value

84− -> Either [Doc] Environment

84+ -> Canonicalizer [Doc] Environment

8585addValue name interface env value =

8686 let insert' x = insert x (Var.Canonical (Var.Module name) x)

8787 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++

8888 "'.\n It is not exported by module " ++ name ++ "."

89− notFound x = Left [ P.text (msg x) ]

89+ notFound x = throwError [ P.text (msg x) ]

9090 in

9191 case value of

9292 Var.Value x

@@ -136,31 +136,31 @@ node name tvars alias = ((name, tvars, alias), name, edges alias)

136136 Type.Record fs ext -> maybe [] edges ext ++ concatMap (edges . snd) fs

137137 Type.Aliased _ t -> edges t

138138

139−addTypeAliases :: String -> [Node] -> Environment -> Either [Doc] Environment

139+addTypeAliases :: String -> [Node] -> Environment -> Canonicalizer [Doc] Environment

140140addTypeAliases moduleName nodes environ =

141141 foldM addTypeAlias environ (Graph.stronglyConnComp nodes)

142142 where

143143 addTypeAlias :: Environment -> Graph.SCC (String, [String], Type.RawType)

144− -> Either [Doc] Environment

144+ -> Canonicalizer [Doc] Environment

145145 addTypeAlias env scc =

146146 case Graph.flattenSCC scc of

147147 [(name, tvars, alias)] ->

148− do alias' <- Either.either throw return (Canonicalize.tipe env alias)

148+ do alias' <- Env.onError throw (Canonicalize.tipe env alias)

149149 let value = (Var.Canonical (Var.Module moduleName) name, tvars, alias')

150150 return $ env { _aliases = insert name value (_aliases env) }

151151 where

152152 throw err =

153153 let msg = "Problem with type alias '" ++ name ++ "':"

154− in Left [ P.vcat [ P.text msg, P.text err ] ]

154+ in P.vcat [ P.text msg, P.text err ]

155155

156156 aliases ->

157− Left [ P.vcat [ P.text (eightyCharLines 0 msg1)

158− , indented (map typeAlias aliases)

159− , P.text (eightyCharLines 0 msg2)

160− , indented (map datatype aliases)

161− , P.text (eightyCharLines 0 msg3)

162− ]

163− ]

157+ throwError [ P.vcat [ P.text (eightyCharLines 0 msg1)

158+ , indented (map typeAlias aliases)

159+ , P.text (eightyCharLines 0 msg2)

160+ , indented (map datatype aliases)

161+ , P.text (eightyCharLines 0 msg3)

162+ ]

163+ ]

164164

165165 typeAlias (n,ts,t) = D.TypeAlias n ts t

166166 datatype (n,ts,t) = D.Datatype n ts [(n,[t])]

compiler/Transform/Canonicalize/Type.hs+5−5

@@ -3,7 +3,7 @@ module Transform.Canonicalize.Type (tipe) where

44import Control.Arrow (second)

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

6−import Control.Monad (when)

6+import Control.Monad.Error

77import qualified Data.Map as Map

88import Data.Traversable (traverse)

@@ -13,7 +13,7 @@ import qualified AST.Variable as Var

1313import Transform.Canonicalize.Environment

1414import qualified Transform.Canonicalize.Variable as Canonicalize

1515

16−tipe :: Environment -> T.RawType -> Either String T.CanonicalType

16+tipe :: Environment -> T.RawType -> Canonicalizer String T.CanonicalType

1717tipe env typ =

1818 let go = tipe env in

1919 case typ of

@@ -29,7 +29,7 @@ tipe env typ =

2929 in T.Record <$> mapM go' fields <*> traverse go ext

3030

3131canonicalizeApp :: Environment -> T.RawType -> [T.RawType]

32− -> Either String T.CanonicalType

32+ -> Canonicalizer String T.CanonicalType

3333canonicalizeApp env f args =

3434 case f of

3535 T.Type (Var.Raw rawName) ->

@@ -44,9 +44,9 @@ canonicalizeApp env f args =

4444

4545canonicalizeAlias :: Environment -> (Var.Canonical, [String], T.CanonicalType)

4646 -> [T.RawType]

47− -> Either String T.CanonicalType

47+ -> Canonicalizer String T.CanonicalType

4848canonicalizeAlias env (name, tvars, dealiasedTipe) tipes =

49− do when (tipesLen /= tvarsLen) (Left msg)

49+ do when (tipesLen /= tvarsLen) (throwError msg)

5050 tipes' <- mapM (tipe env) tipes

5151 let tipe' = replace (Map.fromList (zip tvars tipes')) dealiasedTipe

5252 return $ T.Aliased name tipe'

compiler/Transform/Canonicalize/Variable.hs+15−14

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

11{-# OPTIONS_GHC -Wall #-}

22module Transform.Canonicalize.Variable where

4+import Control.Monad.Error

45import qualified Data.List as List

56import qualified Data.Map as Map

67import Data.Maybe (fromMaybe)

@@ -8,19 +9,19 @@ import Data.Maybe (fromMaybe)

89import AST.Helpers as Help

910import qualified AST.Type as Type

1011import qualified AST.Variable as Var

11−import Transform.Canonicalize.Environment

12+import Transform.Canonicalize.Environment as Env

1213

13−variable :: Environment -> String -> Either String Var.Canonical

14+variable :: Environment -> String -> Canonicalizer String Var.Canonical

1415variable env var =

1516 case modul of

1617 Just ms@(m:_)

17− | m == "Native" -> return (Var.Canonical home name)

18+ | m == "Native" -> Env.using (Var.Canonical home name)

1819 where

1920 home = Var.Module (List.intercalate "." ms)

2021

2122 _ -> case Map.lookup var (_values env) of

22− Just [v] -> return v

23− Just vs -> preferLocals "variable" vs var

23+ Just [v] -> Env.using v

24+ Just vs -> Env.using =<< preferLocals "variable" vs var

2425 Nothing -> notFound "variable" (Map.keys (_values env)) var

2526 where

2627 (modul, name) = case Help.splitDots var of

@@ -28,7 +29,7 @@ variable env var =

2829 xs -> (Just (init xs), last xs)

2930

3031tvar :: Environment -> String

31− -> Either String (Either Var.Canonical (Var.Canonical, [String], Type.CanonicalType))

32+ -> Canonicalizer String (Either Var.Canonical (Var.Canonical, [String], Type.CanonicalType))

3233tvar env var =

3334 case adts ++ aliases of

3435 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var

@@ -43,25 +44,25 @@ tvar env var =

4344 Left v -> v

4445 Right (v,_,_) -> v

4546

46−pvar :: Environment -> String -> Either String Var.Canonical

47+pvar :: Environment -> String -> Canonicalizer String Var.Canonical

4748pvar env var =

4849 case Map.lookup var (_patterns env) of

49− Just [v] -> return v

50− Just vs -> preferLocals "pattern" vs var

50+ Just [v] -> Env.using v

51+ Just vs -> Env.using =<< preferLocals "pattern" vs var

5152 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var

5253

53−notFound :: String -> [String] -> String -> Either String a

54+notFound :: String -> [String] -> String -> Canonicalizer String a

5455notFound kind possibilities var =

55− Left $ "Could not find " ++ kind ++ " '" ++ var ++ "'." ++ msg

56+ throwError $ "Could not find " ++ kind ++ " '" ++ var ++ "'." ++ msg

5657 where

5758 matches = filter (List.isInfixOf var) possibilities

5859 msg = if null matches then "" else

5960 "\nClose matches include: " ++ List.intercalate ", " matches

6061

61−preferLocals :: String -> [Var.Canonical] -> String -> Either String Var.Canonical

62+preferLocals :: String -> [Var.Canonical] -> String -> Canonicalizer String Var.Canonical

6263preferLocals = preferLocals' id

6364

64−preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Either String a

65+preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Canonicalizer String a

6566preferLocals' extract kind possibilities var =

6667 case filter (isLocal . extract) possibilities of

6768 [] -> ambiguous possibilities

@@ -73,7 +74,7 @@ preferLocals' extract kind possibilities var =

7374 isLocal (Var.Canonical _ _) = False

7475

7576 ambiguous possibleVars =

76− Left msg

77+ throwError msg

7778 where

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

7980 msg = "Ambiguous usage of " ++ kind ++ " '" ++ var ++ "'.\n" ++

compiler/Type/Environment.hs−4

@@ -4,7 +4,6 @@ module Type.Environment where

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

55import Control.Exception (try, SomeException)

66import Control.Monad

7−import Control.Monad.Trans.Error (ErrorList(..))

87import Control.Monad.Error (ErrorT, throwError, liftIO)

98import qualified Control.Monad.State as State

109import qualified Data.Traversable as Traverse

@@ -115,9 +114,6 @@ get env subDict key = Map.findWithDefault (error msg) key (subDict env)

115114freshDataScheme :: Environment -> String -> IO (Int, [Variable], [Type], Type)

116115freshDataScheme env name = get env constructor name

117116

118−instance ErrorList PP.Doc where

119− listMsg str = [PP.text str]

120−

121117instantiateType :: Environment -> T.CanonicalType -> VarDict -> ErrorT [PP.Doc] IO ([Variable], Type)

122118instantiateType env sourceType dict =

123119 do result <- liftIO $ try (State.runStateT (instantiator env sourceType) dict)