@@ -1,9 +1,11 @@
11{-# OPTIONS_GHC -Wall #-}
22module Transform.Substitute (subst) where
33
4+import Control.Arrow (second, (***))
45import SourceSyntax.Expression
56import SourceSyntax.Location
6−import Control.Arrow (second, (***))
7+import qualified Data.Set as Set
8+import qualified Transform.SortDefinitions as SD
79
810subst :: String -> Expr t v -> Expr t v -> Expr t v
911subst old new expr =
@@ -12,12 +14,25 @@ subst old new expr =
1214 Range e1 e2 -> Range (f e1) (f e2)
1315 ExplicitList es -> ExplicitList (map f es)
1416 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)
1620 App e1 e2 -> App (f e1) (f e2)
1721 MultiIf ps -> MultiIf (map (f *** f) ps)
18− Let defs body -> Let (map substDef defs) (f body)
19− where substDef (Def name e) = Def name (f e)
20− substDef anno@(TypeAnnotation _ _) = anno
22+
23+ Let defs body
24+ | any hasShadow defs -> expr
25+ | otherwise -> Let (map substDef defs) (f body)
26+ where
27+ hasShadow def =
28+ case def of
29+ TypeAnnotation _ _ -> False
30+ Def pattern _ -> Set.member old (SD.boundVars pattern)
31+ substDef def =
32+ case def of
33+ TypeAnnotation _ _ -> def
34+ Def p e -> Def p (f e)
35+
2136 Var x -> if x == old then new else expr
2237 Case e cases -> Case (f e) $ map (second f) cases
2338 Data name es -> Data name (map f es)
@@ -27,4 +42,4 @@ subst old new expr =
2742 Modify r fs -> Modify (f r) (map (second f) fs)
2843 Record fs -> Record (map (second f) fs)
2944 Literal _ -> expr
30− Markdown md es -> Markdown md (map f es)
45+ Markdown md es -> Markdown md (map f es)