git.iko.soy/elk
on master help sign in
improve style, rename update to addPattern
60d3afbEvan Czaplicki
src/Transform/Canonicalize.hs+32−13
compare with master
unifiedsplit
@@ -22,7 +22,7 @@ import AST.PrettyPrint (pretty, commaSep)
22import qualified AST.Pattern as P
22import qualified AST.Pattern as P
23import Text.PrettyPrint as P
23import Text.PrettyPrint as P
24
24
25−import Transform.Canonicalize.Environment as Env
25+import qualified Transform.Canonicalize.Environment as Env
26import qualified Transform.Canonicalize.Setup as Setup
26import qualified Transform.Canonicalize.Setup as Setup
27import qualified Transform.Canonicalize.Type as Canonicalize
27import qualified Transform.Canonicalize.Type as Canonicalize
28import qualified Transform.Canonicalize.Variable as Canonicalize
28import qualified Transform.Canonicalize.Variable as Canonicalize
@@ -30,7 +30,10 @@ import qualified Transform.SortDefinitions as Transform
30import qualified Transform.Declaration as Transform
30import qualified Transform.Declaration as Transform
31
31
32
32
33+module'
34+ :: Module.Interfaces
35+ -> Module.ValidModule
33−module' :: Module.Interfaces -> Module.ValidModule -> Either [Doc] Module.CanonicalModule
36+ -> Either [Doc] Module.CanonicalModule
34module' interfaces modul =
37module' interfaces modul =
35 filterImports <$> modul'
38 filterImports <$> modul'
36 where
39 where
@@ -39,11 +42,14 @@ module' interfaces modul =
39
42
40 filterImports m =
43 filterImports m =
41 let used (name,_) = Set.member name usedModules
44 let used (name,_) = Set.member name usedModules
45+ in
42− in m { Module.imports = filter used (Module.imports m) }
46+ m { Module.imports = filter used (Module.imports m) }
43
47
44
48
49+moduleHelp
50+ :: Module.Interfaces
45−moduleHelp :: Module.Interfaces -> Module.ValidModule
51+ -> Module.ValidModule
46− -> Canonicalizer [Doc] Module.CanonicalModule
52+ -> Env.Canonicalizer [Doc] Module.CanonicalModule
47moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
53moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
48 do env <- Setup.environment interfaces modul
54 do env <- Setup.environment interfaces modul
49 canonicalDecls <- mapM (declaration env) decls
55 canonicalDecls <- mapM (declaration env) decls
@@ -74,7 +80,10 @@ moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
74 }
80 }
75
81
76
82
83+resolveExports
84+ :: [Var.Value]
85+ -> Var.Listing Var.Value
77−resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
86+ -> Env.Canonicalizer [Doc] [Var.Value]
78resolveExports fullList (Var.Listing partialList open) =
87resolveExports fullList (Var.Listing partialList open) =
79 if open
88 if open
80 then return fullList
89 then return fullList
@@ -164,7 +173,10 @@ declToValue decl =
164 _ -> []
173 _ -> []
165
174
166
175
176+declaration
177+ :: Env.Environment
178+ -> D.ValidDecl
167−declaration :: Environment -> D.ValidDecl -> Canonicalizer [Doc] D.CanonicalDecl
179+ -> Env.Canonicalizer [Doc] D.CanonicalDecl
168declaration env decl =
180declaration env decl =
169 let canonicalize kind context pattern env v =
181 let canonicalize kind context pattern env v =
170 let ctx = P.text ("Error in " ++ context) <+> pretty pattern <> P.colon
182 let ctx = P.text ("Error in " ++ context) <+> pretty pattern <> P.colon
@@ -206,7 +218,10 @@ declaration env decl =
206 return $ D.Fixity assoc prec op
218 return $ D.Fixity assoc prec op
207
219
208
220
221+expression
222+ :: Env.Environment
223+ -> Valid.Expr
209−expression :: Environment -> Valid.Expr -> Canonicalizer [Doc] Canonical.Expr
224+ -> Env.Canonicalizer [Doc] Canonical.Expr
210expression env (A.A ann expr) =
225expression env (A.A ann expr) =
211 let go = expression env
226 let go = expression env
212 tipe' environ = format . Canonicalize.tipe environ
227 tipe' environ = format . Canonicalize.tipe environ
@@ -245,8 +260,9 @@ expression env (A.A ann expr) =
245 Binop op' <$> go e1 <*> go e2
260 Binop op' <$> go e1 <*> go e2
246
261
247 Lambda p e ->
262 Lambda p e ->
248− let env' = update p env in
263+ let env' = Env.addPattern p env
264+ in
249− Lambda <$> format (pattern env' p) <*> expression env' e
265+ Lambda <$> format (pattern env' p) <*> expression env' e
250
266
251 App e1 e2 ->
267 App e1 e2 ->
252 App <$> go e1 <*> go e2
268 App <$> go e1 <*> go e2
@@ -259,7 +275,7 @@ expression env (A.A ann expr) =
259 Let defs e ->
275 Let defs e ->
260 Let <$> mapM rename' defs <*> expression env' e
276 Let <$> mapM rename' defs <*> expression env' e
261 where
277 where
262− env' = foldr update env $ map (\(Valid.Definition p _ _) -> p) defs
278+ env' = foldr Env.addPattern env $ map (\(Valid.Definition p _ _) -> p) defs
263 rename' (Valid.Definition p body mtipe) =
279 rename' (Valid.Definition p body mtipe) =
264 Canonical.Definition
280 Canonical.Definition
265 <$> format (pattern env' p)
281 <$> format (pattern env' p)
@@ -280,7 +296,7 @@ expression env (A.A ann expr) =
280 where
296 where
281 branch (p,b) =
297 branch (p,b) =
282 (,) <$> format (pattern env p)
298 (,) <$> format (pattern env p)
283− <*> expression (update p env) b
299+ <*> expression (Env.addPattern p env) b
284
300
285 PortIn name st ->
301 PortIn name st ->
286 PortIn name <$> tipe' env st
302 PortIn name <$> tipe' env st
@@ -292,7 +308,10 @@ expression env (A.A ann expr) =
292 return (GLShader uid src tipe)
308 return (GLShader uid src tipe)
293
309
294
310
311+pattern
312+ :: Env.Environment
313+ -> P.RawPattern
295−pattern :: Environment -> P.RawPattern -> Canonicalizer String P.CanonicalPattern
314+ -> Env.Canonicalizer String P.CanonicalPattern
296pattern env ptrn =
315pattern env ptrn =
297 case ptrn of
316 case ptrn of
298 P.Var x -> return $ P.Var x
317 P.Var x -> return $ P.Var x
src/Transform/Canonicalize/Environment.hs+6−5
@@ -40,14 +40,15 @@ builtIns home =
40 dict $ map (\x -> (x, Var.Canonical Var.BuiltIn x)) xs
40 dict $ map (\x -> (x, Var.Canonical Var.BuiltIn x)) xs
41
41
42 tuples =
42 tuples =
43− map (\n -> "_Tuple" ++ show (n :: Int)) [0..9]
43+ map (\n -> "_Tuple" ++ show n) [0 .. 9 :: Int]
44
44
45
45
46−update :: P.Pattern var -> Environment -> Environment
46+addPattern :: P.Pattern var -> Environment -> Environment
47−update ptrn env =
47+addPattern ptrn env =
48 env { _values = foldr put (_values env) (P.boundVarList ptrn) }
48 env { _values = foldr put (_values env) (P.boundVarList ptrn) }
49 where
49 where
50+ put x =
50− put x = Map.insert x [Var.local x]
51+ Map.insert x [Var.local x]
51
52
52
53
53merge :: Environment -> Environment -> Environment
54merge :: Environment -> Environment -> Environment
@@ -70,7 +71,7 @@ type Dict a =
70
71
71dict :: [(String,a)] -> Dict a
72dict :: [(String,a)] -> Dict a
72dict pairs =
73dict pairs =
73− Map.fromList $ map (second (:[])) pairs
74+ Map.fromList (map (second (:[])) pairs)
74
75
75
76
76insert :: String -> a -> Dict a -> Dict a
77insert :: String -> a -> Dict a -> Dict a