@@ -1,9 +1,11 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Substitute (subst) where
2module Transform.Substitute (subst) where
4+import Control.Arrow (second, (***))
4import SourceSyntax.Expression
5import SourceSyntax.Expression
5import SourceSyntax.Location
6import SourceSyntax.Location
6−import Control.Arrow (second, (***))
7+import qualified Data.Set as Set
8+import qualified Transform.SortDefinitions as SD
8subst :: String -> Expr t v -> Expr t v -> Expr t v
10subst :: String -> Expr t v -> Expr t v -> Expr t v
9subst old new expr =
11subst old new expr =
@@ -12,12 +14,25 @@ subst old new expr =
12 Range e1 e2 -> Range (f e1) (f e2)
14 Range e1 e2 -> Range (f e1) (f e2)
13 ExplicitList es -> ExplicitList (map f es)
15 ExplicitList es -> ExplicitList (map f es)
14 Binop op e1 e2 -> Binop op (f e1) (f e2)
16 Binop op e1 e2 -> Binop op (f e1) (f e2)
15− Lambda p e -> Lambda p (f e)
17+ Lambda p e
18+ | Set.member old (SD.boundVars p) -> expr
19+ | otherwise -> Lambda p (f e)
16 App e1 e2 -> App (f e1) (f e2)
20 App e1 e2 -> App (f e1) (f e2)
17 MultiIf ps -> MultiIf (map (f *** f) ps)
21 MultiIf ps -> MultiIf (map (f *** f) ps)
24+ | any hasShadow defs -> expr
18− Let defs body -> Let (map substDef defs) (f body)
25+ | otherwise -> Let (map substDef defs) (f body)
19− where substDef (Def name e) = Def name (f e)
26+ where
29+ TypeAnnotation _ _ -> False
30+ Def pattern _ -> Set.member old (SD.boundVars pattern)
20− substDef anno@(TypeAnnotation _ _) = anno
33+ TypeAnnotation _ _ -> def
34+ Def p e -> Def p (f e)
21 Var x -> if x == old then new else expr
36 Var x -> if x == old then new else expr
22 Case e cases -> Case (f e) $ map (second f) cases
37 Case e cases -> Case (f e) $ map (second f) cases
23 Data name es -> Data name (map f es)
38 Data name es -> Data name (map f es)
@@ -27,4 +42,4 @@ subst old new expr =
27 Modify r fs -> Modify (f r) (map (second f) fs)
42 Modify r fs -> Modify (f r) (map (second f) fs)
28 Record fs -> Record (map (second f) fs)
43 Record fs -> Record (map (second f) fs)
29 Literal _ -> expr
44 Literal _ -> expr
30− Markdown md es -> Markdown md (map f es)
45+ Markdown md es -> Markdown md (map f es)