on master help sign in
Rename a file to LetBoundVars.hs to extract only variable names defined in let expressions.
commit45586e07381f9b6cb5ed0e5c775ca55d5f777ba7 authorevancz <info@elm-lang.org> dateTue 26 Feb 2013, 23:25 (14 years ago) parent30ad0fb
2 files changed+53−32
elm/src/FreeVar.hs−32 elm/src/LetBoundVars.hs+53
elm/src/FreeVar.hsdeleted−32
@@ -1,32 +0,0 @@
1−module FreeVar (freeIn,freeVars) where
2−
3−import Ast
4−import Control.Arrow ((***))
5−import Data.Set (union, unions, delete, singleton, empty, difference, member)
6−
7−x `freeIn` expr = member x $ freeVars expr
8−
9−freeVars expr =
10− let f = freeVars in
11− case expr of
12− Range e1 e2 -> f e1 `union` f e2
13− Binop op e1 e2 -> f e1 `union` f e2
14− Lambda x e -> delete x (f e)
15− App e1 e2 -> f e1 `union` f e2
16− If e1 e2 e3 -> unions $ map f [e1,e2,e3]
17− Guard ps -> map (f *** f) ps
18− Lift e es -> unions $ map f es
19− Fold e1 e2 e3 -> unions $ map f [e1,e2,e3]
20− Async e -> f e
21− Let defs e -> foldr delete (unions (f e : map f es)) vs
22− where (vs,es) = unzip defs
23− Var x -> singleton x
24− Data name es -> unions (map f es)
25− Case e cases -> f e `union` unions (map caseFreeVars cases)
26− _ -> empty
27−
28−caseFreeVars (p,e) = difference (freeVars e) (pvars p)
29− where pvars p = case p of
30− PAnything -> empty
31− PVar x -> singleton x
32− PData _ ps -> unions (map pvars ps)
elm/src/LetBoundVars.hsnew file+53
@@ -0,0 +1,53 @@
1+module LetBoundVars (letBoundVars) where
2+
3+import Context
4+import Ast
5+
6+class LetBoundVars a where
7+ letBoundVars :: a -> [String]
8+
9+instance LetBoundVars a => LetBoundVars [a] where
10+ letBoundVars = concatMap letBoundVars
11+
12+instance LetBoundVars Statement where
13+ letBoundVars stmt =
14+ case stmt of
15+ Definition d -> letBoundVars d
16+ Datatype _ _ tcs -> []
17+ ImportEvent _ e _ _ -> letBoundVars' e
18+ ExportEvent _ _ _ -> []
19+ TypeAnnotation _ _ -> []
20+ TypeAlias _ _ _ -> []
21+
22+instance LetBoundVars Def where
23+ letBoundVars (FnDef n _ e) = n : letBoundVars' e
24+ letBoundVars (OpDef _ _ _ e) = letBoundVars' e
25+
26+letBoundVars' :: CExpr -> [String]
27+letBoundVars' (C _ _ e) = letBoundVars e
28+
29+instance LetBoundVars Expr where
30+ letBoundVars expr =
31+ let f = letBoundVars' in
32+ case expr of
33+ IntNum _ -> []
34+ FloatNum _ -> []
35+ Chr _ -> []
36+ Str _ -> []
37+ Boolean _ -> []
38+ Range e1 e2 -> f e1 ++ f e2
39+ Access e _ -> []
40+ Remove e _ -> []
41+ Insert e1 _ e2 -> f e1 ++ f e2
42+ Modify e ps -> f e ++ concatMap (f . snd) ps
43+ Record trps -> concatMap (\(_,_,e) -> f e) trps
44+ Binop op e1 e2 -> f e1 ++ f e2
45+ Lambda x e -> f e
46+ App e1 e2 -> f e1 ++ f e2
47+ If e1 e2 e3 -> concatMap f [e1,e2,e3]
48+ MultiIf ps -> concatMap (\(b,e) -> f b ++ f e) ps
49+ Let defs e -> concatMap letBoundVars defs ++ f e
50+ Var x -> []
51+ Data name es -> concatMap f es
52+ Case e cases -> f e ++ concatMap (f . snd) cases
53+ Markdown _ -> []