git.iko.soy/elk
on master help sign in
Don't try to find interface for Native modules
7868a2bEvan Czaplicki
compiler/Transform/Canonicalize.hs+21−17
compare with master
unifiedsplit
@@ -6,7 +6,6 @@ import Control.Arrow (first)
6import Control.Monad (foldM)
6import Control.Monad (foldM)
7import qualified Data.Either as Either
7import qualified Data.Either as Either
8import qualified Data.List as List
8import qualified Data.List as List
9−import Data.Map ((!))
10import qualified Data.Map as Map
9import qualified Data.Map as Map
11import qualified Data.Traversable as T
10import qualified Data.Traversable as T
12
11
@@ -24,7 +23,7 @@ import AST.PrettyPrint (pretty, commaSep)
24import qualified AST.Pattern as P
23import qualified AST.Pattern as P
25import Text.PrettyPrint as P
24import Text.PrettyPrint as P
26
25
27−import Transform.Canonicalize.Environment
26+import Transform.Canonicalize.Environment as Env
28import Transform.Canonicalize.Type
27import Transform.Canonicalize.Type
29import Transform.Canonicalize.Variable (variable, pvar)
28import Transform.Canonicalize.Variable (variable, pvar)
30import qualified Transform.SortDefinitions as Transform
29import qualified Transform.SortDefinitions as Transform
@@ -33,23 +32,26 @@ import qualified Transform.Declaration as Transform
33environment :: Interfaces -> Module.ValidModule -> Either [Doc] Environment
32environment :: Interfaces -> Module.ValidModule -> Either [Doc] Environment
34environment interfaces (Module.Module _ _ _ ims decls) =
33environment interfaces (Module.Module _ _ _ ims decls) =
35 do () <- allImportsAvailable interfaces ims
34 do () <- allImportsAvailable interfaces ims
36− nonLocalEnv <- foldM (toEnv interfaces) builtIns ims
35+ nonLocalEnv <- foldM (toEnv interfaces) Env.builtIns ims
37− foldM (flip addDecl) nonLocalEnv decls
36+ foldM addDecl nonLocalEnv decls
38
37
39toEnv :: Interfaces -> Environment -> (String, ImportMethod) -> Either [Doc] Environment
38toEnv :: Interfaces -> Environment -> (String, ImportMethod) -> Either [Doc] Environment
40−toEnv interfaces environ (name,method) =
39+toEnv interfaces environ (name,method)
40+ | List.isPrefixOf "Native." name = return environ
41+ | otherwise =
41− case method of
42+ case method of
42− Module.As name' ->
43+ Module.As name' ->
43− return (env (name' ++ "."))
44+ return (updateEnviron (name' ++ "."))
44−
45+
45− Module.Open (Var.Listing vs open)
46+ Module.Open (Var.Listing vs open)
46− | open -> return (env "")
47+ | open -> return (updateEnviron "")
47− | otherwise -> foldM (addValue name interface) environ vs
48+ | otherwise -> foldM (addValue name interface) environ vs
48 where
49 where
49− interface = interfaces ! name
50+ interface = (Map.!) interfaces name
50
51
51− env prefix =
52+ updateEnviron prefix =
52 let dict' = dict . map (first (prefix++)) in
53 let dict' = dict . map (first (prefix++)) in
54+ merge environ $
53 Env { _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
55 Env { _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
54 , _adts = dict' $ map pair (Map.keys (iAdts interface))
56 , _adts = dict' $ map pair (Map.keys (iAdts interface))
55 , _aliases = dict' $ map alias (Map.toList (iAliases interface))
57 , _aliases = dict' $ map alias (Map.toList (iAliases interface))
@@ -104,8 +106,8 @@ addValue name interface env value =
104 [] -> return names
106 [] -> return names
105 c:_ -> notFound c
107 c:_ -> notFound c
106
108
107−addDecl :: D.ValidDecl -> Environment -> Either [Doc] Environment
109+addDecl :: Environment -> D.ValidDecl -> Either [Doc] Environment
108−addDecl decl env =
110+addDecl env decl =
109 case decl of
111 case decl of
110 D.Definition (Valid.Definition pattern _ _) ->
112 D.Definition (Valid.Definition pattern _ _) ->
111 return $ env
113 return $ env
@@ -247,12 +249,14 @@ declaration env decl =
247
249
248allImportsAvailable :: Interfaces -> [(String,ImportMethod)] -> Either [Doc] ()
250allImportsAvailable :: Interfaces -> [(String,ImportMethod)] -> Either [Doc] ()
249allImportsAvailable interfaces imports =
251allImportsAvailable interfaces imports =
250− case filter (`Map.notMember` interfaces) modules of
252+ case filter (not . found) modules of
251 [] -> Right ()
253 [] -> Right ()
252 missings -> Left [ P.text (missingModuleError missings) ]
254 missings -> Left [ P.text (missingModuleError missings) ]
253 where
255 where
254 modules = map fst imports
256 modules = map fst imports
255
257
258+ found m = Map.member m interfaces || List.isPrefixOf "Native." m
259+
256 missingModuleError missings =
260 missingModuleError missings =
257 concat [ "The following imports were not found: "
261 concat [ "The following imports were not found: "
258 , List.intercalate ", " missings
262 , List.intercalate ", " missings