on 577fc17 help sign in
elk/compiler/Transform/Substitute.hs
51 lines 1.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Substitute (subst) where
4import Control.Arrow (second, (***))
5import qualified Data.Set as Set
7import AST.Annotation
8import AST.Expression.General (Expr'(..))
9import qualified AST.Expression.Canonical as Canonical
10import qualified AST.Pattern as Pattern
11import qualified AST.Variable as V
13subst :: String -> Canonical.Expr' -> Canonical.Expr' -> Canonical.Expr'
14subst old new expr =
15 let f (A a e) = A a (subst old new e) in
16 case expr of
17 Range e1 e2 -> Range (f e1) (f e2)
18 ExplicitList es -> ExplicitList (map f es)
19 Binop op e1 e2 -> Binop op (f e1) (f e2)
20 Lambda p e
21 | Set.member old (Pattern.boundVars p) -> expr
22 | otherwise -> Lambda p (f e)
23 App e1 e2 -> App (f e1) (f e2)
24 MultiIf ps -> MultiIf (map (f *** f) ps)
26 Let defs body
27 | anyShadow -> expr
28 | otherwise -> Let (map substDef defs) (f body)
29 where
30 substDef (Canonical.Definition p e t) = Canonical.Definition p (f e) t
31 anyShadow =
32 any (Set.member old . Pattern.boundVars) [ p | Canonical.Definition p _ _ <- defs ]
34 Var (V.Canonical home x) ->
35 case home of
36 V.Module _ -> expr
37 V.BuiltIn -> expr
38 V.Local -> if x == old then new else expr
40 Case e cases -> Case (f e) $ map (second f) cases
41 Data name es -> Data name (map f es)
42 Access e x -> Access (f e) x
43 Remove e x -> Remove (f e) x
44 Insert e x v -> Insert (f e) x (f v)
45 Modify r fs -> Modify (f r) (map (second f) fs)
46 Record fs -> Record (map (second f) fs)
47 Literal _ -> expr
48 Markdown uid md es -> Markdown uid md (map f es)
49 GLShader _ _ _ -> expr
50 PortIn name st -> PortIn name st
51 PortOut name st signal -> PortOut name st (f signal)