git.iko.soy/elk
on master help sign in
Use more qualified names
1c485a0Evan Czaplicki
src/Transform/Canonicalize/Setup.hs+19−15
compare with master
unifiedsplit
@@ -23,7 +23,9 @@ import AST.PrettyPrint (pretty, eightyCharLines)
23import qualified AST.Pattern as P
23import qualified AST.Pattern as P
24import Text.PrettyPrint as P
24import Text.PrettyPrint as P
25
25
26−import Transform.Canonicalize.Environment as Env
26+import Transform.Canonicalize.Environment
27+ ( Canonicalizer, Environment(Env, _home, _values, _adts, _aliases, _patterns) )
28+import qualified Transform.Canonicalize.Environment as Env
27import qualified Transform.Canonicalize.Type as Canonicalize
29import qualified Transform.Canonicalize.Type as Canonicalize
28import qualified Transform.Interface as Interface
30import qualified Transform.Interface as Interface
29
31
@@ -38,7 +40,7 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =
38 Module.names modul
40 Module.names modul
39
41
40 nonLocalEnv <-
42 nonLocalEnv <-
41− foldM (addImports moduleName interfaces) (builtIns moduleName) imports
43+ foldM (addImports moduleName interfaces) (Env.builtIns moduleName) imports
42
44
43 let (aliases, env) =
45 let (aliases, env) =
44 List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
46 List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
@@ -94,14 +96,16 @@ addImports moduleName interfaces environ (name, method)
94 Interface.filterExports ((Map.!) interfaces name)
96 Interface.filterExports ((Map.!) interfaces name)
95
97
96 updateEnviron prefix env =
98 updateEnviron prefix env =
97− let dict' = dict . map (first (prefix++)) in
99+ let dict' pairs = Env.dict (map (first (prefix++)) pairs)
100+ in
98− merge env $
101+ Env.merge env $
102+ Env
99− Env { _home = moduleName
103+ { _home = moduleName
100− , _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
104+ , _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
101− , _adts = dict' $ map pair (Map.keys (iAdts interface))
105+ , _adts = dict' $ map pair (Map.keys (iAdts interface))
102− , _aliases = dict' $ map alias (Map.toList (iAliases interface))
106+ , _aliases = dict' $ map alias (Map.toList (iAliases interface))
103− , _patterns = dict' $ ctors
107+ , _patterns = dict' $ ctors
104− }
108+ }
105
109
106 canonical :: String -> Var.Canonical
110 canonical :: String -> Var.Canonical
107 canonical =
111 canonical =
@@ -128,7 +132,7 @@ addValue
128 -> Canonicalizer [Doc] Environment
132 -> Canonicalizer [Doc] Environment
129addValue moduleName interface env value =
133addValue moduleName interface env value =
130 let name = Module.nameToString moduleName
134 let name = Module.nameToString moduleName
131− insert' x = insert x (Var.Canonical (Var.Module moduleName) x)
135+ insert' x = Env.insert x (Var.Canonical (Var.Module moduleName) x)
132 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++
136 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++
133 "'.\n It is not exported by module " ++ name ++ "."
137 "'.\n It is not exported by module " ++ name ++ "."
134 notFound x = throwError [ P.text (msg x) ]
138 notFound x = throwError [ P.text (msg x) ]
@@ -145,7 +149,7 @@ addValue moduleName interface env value =
145 case Map.lookup x (iAliases interface) of
149 case Map.lookup x (iAliases interface) of
146 Just (tvars, t) ->
150 Just (tvars, t) ->
147 return $ env
151 return $ env
148− { _aliases = insert x v (_aliases env)
152+ { _aliases = Env.insert x v (_aliases env)
149 , _values = updatedValues
153 , _values = updatedValues
150 }
154 }
151 where
155 where
@@ -231,7 +235,7 @@ addTypeAlias moduleName env scc =
231 [(name, tvars, alias)] ->
235 [(name, tvars, alias)] ->
232 do alias' <- Env.onError throw (Canonicalize.tipe env alias)
236 do alias' <- Env.onError throw (Canonicalize.tipe env alias)
233 let value = (Var.Canonical (Var.Module moduleName) name, tvars, alias')
237 let value = (Var.Canonical (Var.Module moduleName) name, tvars, alias')
234− return $ env { _aliases = insert name value (_aliases env) }
238+ return $ env { _aliases = Env.insert name value (_aliases env) }
235 where
239 where
236 throw err =
240 throw err =
237 let msg = "Problem with type alias '" ++ name ++ "':"
241 let msg = "Problem with type alias '" ++ name ++ "':"
@@ -294,8 +298,8 @@ addDecl
294 -> ([Node], Environment)
298 -> ([Node], Environment)
295addDecl moduleName info@(nodes,env) decl =
299addDecl moduleName info@(nodes,env) decl =
296 let namespacedVar = Var.Canonical (Var.Module moduleName)
300 let namespacedVar = Var.Canonical (Var.Module moduleName)
297− addLocal x e = insert x (Var.local x) e
301+ addLocal x e = Env.insert x (Var.local x) e
298− addNamespaced x e = insert x (namespacedVar x) e
302+ addNamespaced x e = Env.insert x (namespacedVar x) e
299 in
303 in
300 case decl of
304 case decl of
301 D.Definition (Valid.Definition pattern _ _) ->
305 D.Definition (Valid.Definition pattern _ _) ->