git.iko.soy/elk
on master help sign in
Handle imports more nicely during canonicalization
50f8defEvan Czaplicki
compiler/src/Canonicalize/Environment/Foreign.hs+10−47
compare with master
unifiedsplit
@@ -10,6 +10,7 @@ module Canonicalize.Environment.Foreign
10import Control.Monad (foldM)
10import Control.Monad (foldM)
11import qualified Data.List as List
11import qualified Data.List as List
12import qualified Data.Map.Strict as Map
12import qualified Data.Map.Strict as Map
13+import Data.Map.Strict ((!))
13import qualified Data.Name as Name
14import qualified Data.Name as Name
14
15
15import qualified AST.Canonical as Can
16import qualified AST.Canonical as Can
@@ -30,26 +31,12 @@ type Result i w a =
30 Result.Result i w Error.Error a
31 Result.Result i w Error.Error a
31
32
32
33
33−
34−-- CREATE ENVIRONMENT
35−
36−
37−type ImportDict =
38− Map.Map Name.Name ModuleName.Canonical
39−
40−
41−createInitialEnv :: ModuleName.Canonical -> ImportDict -> I.Interfaces -> [Src.Import] -> Result i w Env.Env
34+createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
42−createInitialEnv home importDict interfaces sourceImports =
35+createInitialEnv home ifaces imports =
43− do imports <- traverse (verifyImport importDict interfaces) (filter isNotKernel sourceImports)
44− (State vs ts cs bs qvs qts qcs) <- foldM addImport emptyState imports
36+ do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState imports
45 Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
37 Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
46
38
47
39
48−isNotKernel :: Src.Import -> Bool
49−isNotKernel (Src.Import (A.At _ name) _ _) =
50− not (Name.isKernel name)
51−
52−
53
40
54-- STATE
41-- STATE
55
42
@@ -80,9 +67,13 @@ emptyTypes =
80-- ADD IMPORTS
67-- ADD IMPORTS
81
68
82
69
83−addImport :: State -> Import -> Result i w State
70+addImport :: Map.Map ModuleName.Raw I.Interface -> State -> Src.Import -> Result i w State
84−addImport (State vs ts cs bs qvs qts qcs) (Import home (I.Interface defs unions aliases binops) prefix exposing) =
71+addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing) =
85 let
72 let
73+ (I.Interface pkg defs unions aliases binops) = ifaces ! name
74+ !prefix = maybe name id maybeAlias
75+ !home = ModuleName.Canonical pkg name
76+
86 !rawTypeInfo =
77 !rawTypeInfo =
87 Map.union
78 Map.union
88 (Map.mapMaybeWithKey (unionToType home) unions)
79 (Map.mapMaybeWithKey (unionToType home) unions)
@@ -276,31 +267,3 @@ toCtors types =
276
267
277 _ ->
268 _ ->
278 dict
269 dict
279−
280−
281−
282−-- VERIFY IMPORT
283−
284−
285−data Import =
286− Import
287− { _name :: ModuleName.Canonical
288− , _interface :: I.Interface
289− , _prefix :: Name.Name
290− , _exposing :: Src.Exposing
291− }
292−
293−
294−verifyImport :: ImportDict -> I.Interfaces -> Src.Import -> Result i w Import
295−verifyImport importDict interfaces (Src.Import (A.At region name) alias exposing) =
296− case Map.lookup name importDict of
297− Just canonicalName ->
298− case Map.lookup canonicalName interfaces of
299− Just interface ->
300− Result.ok (Import canonicalName interface (maybe name id alias) exposing)
301−
302− Nothing ->
303− Result.throw $ Error.ImportNotFound region name (Map.keys interfaces)
304−
305− Nothing ->
306− Result.throw $ Error.ImportNotFound region name (Map.elems importDict)
compiler/src/Canonicalize/Module.hs+5−10
@@ -41,19 +41,14 @@ type Result i w a =
41-- MODULES
41-- MODULES
42
42
43
43
44−canonicalize
45− :: Pkg.Name
46− -> Map.Map Name.Name ModuleName.Canonical
47− -> I.Interfaces
48− -> Src.Module
49− -> Result i [W.Warning] Can.Module
44+canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Result i [W.Warning] Can.Module
50−canonicalize pkg importDict interfaces module_@(Src.Module name exports imports values _ _ binops effects) =
45+canonicalize pkg ifaces modul@(Src.Module _ exports imports values _ _ binops effects) =
51− do let home = ModuleName.Canonical pkg name
46+ do let home = ModuleName.Canonical pkg (Src.getName modul)
52 let cbinops = Map.fromList (map canonicalizeBinop binops)
47 let cbinops = Map.fromList (map canonicalizeBinop binops)
53
48
54 (env, cunions, caliases) <-
49 (env, cunions, caliases) <-
55− Local.add module_ =<<
50+ Local.add modul =<<
56− Foreign.createInitialEnv home importDict interfaces imports
51+ Foreign.createInitialEnv home ifaces imports
57
52
58 cvalues <- canonicalizeValues env values
53 cvalues <- canonicalizeValues env values
59 ceffects <- Effects.canonicalize env values cunions effects
54 ceffects <- Effects.canonicalize env values cunions effects