on master help sign in
Move `boundVars` function into SourceSyntax.Pattern
3c65b5cEvan Czaplicki
compiler/SourceSyntax/Pattern.hs+11
@@ -4,6 +4,7 @@ import Data.List (intercalate)
4import SourceSyntax.Helpers as Help
4import SourceSyntax.Helpers as Help
5import SourceSyntax.PrettyPrint
5import SourceSyntax.PrettyPrint
6import Text.PrettyPrint as PP
6import Text.PrettyPrint as PP
7+import qualified Data.Set as Set
7import SourceSyntax.Literal as Literal
8import SourceSyntax.Literal as Literal
8
9
9data Pattern = PData String [Pattern]
10data Pattern = PData String [Pattern]
@@ -19,6 +20,16 @@ nil = PData "[]" []
19list = foldr cons nil
20list = foldr cons nil
20tuple es = PData ("_Tuple" ++ show (length es)) es
21tuple es = PData ("_Tuple" ++ show (length es)) es
21
22
23+boundVars :: Pattern -> Set.Set String
24+boundVars pattern =
25+ case pattern of
26+ PVar x -> Set.singleton x
27+ PAlias x p -> Set.insert x (boundVars p)
28+ PData _ ps -> Set.unions (map boundVars ps)
29+ PRecord fields -> Set.fromList fields
30+ PAnything -> Set.empty
31+ PLiteral _ -> Set.empty
32+
22
33
23instance Pretty Pattern where
34instance Pretty Pattern where
24 pretty pattern =
35 pretty pattern =
compiler/Transform/Substitute.hs+5−8
@@ -4,10 +4,10 @@ module Transform.Substitute (subst) where
4import Control.Arrow (second, (***))
4import Control.Arrow (second, (***))
5import SourceSyntax.Expression
5import SourceSyntax.Expression
6import SourceSyntax.Location
6import SourceSyntax.Location
7+import qualified SourceSyntax.Pattern as Pattern
7import qualified Data.Set as Set
8import qualified Data.Set as Set
8−import qualified Transform.SortDefinitions as SD
9
9
10−subst :: String -> Expr t v -> Expr t v -> Expr t v
10+subst :: String -> Expr -> Expr -> Expr
11subst old new expr =
11subst old new expr =
12 let f (L s e) = L s (subst old new e) in
12 let f (L s e) = L s (subst old new e) in
13 case expr of
13 case expr of
@@ -15,7 +15,7 @@ subst old new expr =
15 ExplicitList es -> ExplicitList (map f es)
15 ExplicitList es -> ExplicitList (map f es)
16 Binop op e1 e2 -> Binop op (f e1) (f e2)
16 Binop op e1 e2 -> Binop op (f e1) (f e2)
17 Lambda p e
17 Lambda p e
18− | Set.member old (SD.boundVars p) -> expr
18+ | Set.member old (Pattern.boundVars p) -> expr
19 | otherwise -> Lambda p (f e)
19 | otherwise -> Lambda p (f e)
20 App e1 e2 -> App (f e1) (f e2)
20 App e1 e2 -> App (f e1) (f e2)
21 MultiIf ps -> MultiIf (map (f *** f) ps)
21 MultiIf ps -> MultiIf (map (f *** f) ps)
@@ -24,12 +24,9 @@ subst old new expr =
24 | anyShadow -> expr
24 | anyShadow -> expr
25 | otherwise -> Let (map substDef defs) (f body)
25 | otherwise -> Let (map substDef defs) (f body)
26 where
26 where
27+ substDef (Definition p e t) = Definition p (f e) t
27 anyShadow =
28 anyShadow =
28− any (Set.member old . SD.boundVars) [ p | Def p _ <- defs ]
29+ any (Set.member old . Pattern.boundVars) [ p | Definition p _ _ <- defs ]
29− substDef def =
30− case def of
31− TypeAnnotation _ _ -> def
32− Def p e -> Def p (f e)
33
30
34 Var x -> if x == old then new else expr
31 Var x -> if x == old then new else expr
35 Case e cases -> Case (f e) $ map (second f) cases
32 Case e cases -> Case (f e) $ map (second f) cases