git.iko.soy/elk
on d87affe help sign in
elk/src/Transform/Substitute.hs
90 lines 2.4 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
14subst :: String -> Canonical.Expr' -> Canonical.Expr' -> Canonical.Expr'
15subst old new expression =
16 let f (A a e) = A a (subst old new e) in
17 case expression of
18 Range e1 e2 ->
19 Range (f e1) (f e2)
21 ExplicitList exprs ->
22 ExplicitList (map f exprs)
24 Binop op e1 e2 ->
25 Binop op (f e1) (f e2)
27 Lambda pattern body
28 | Set.member old (Pattern.boundVars pattern) -> expression
29 | otherwise -> Lambda pattern (f body)
31 App e1 e2 ->
32 App (f e1) (f e2)
34 MultiIf branches ->
35 MultiIf (map (f *** f) branches)
37 Let defs body
38 | anyShadow -> expression
39 | otherwise -> Let (map substDef defs) (f body)
40 where
41 substDef (Canonical.Definition p e t) =
42 Canonical.Definition p (f e) t
44 anyShadow =
45 any (Set.member old . Pattern.boundVars)
46 [ pattern | Canonical.Definition pattern _ _ <- defs ]
48 Var (V.Canonical home x) ->
49 case home of
50 V.Module _ -> expression
51 V.BuiltIn -> expression
52 V.Local -> if x == old then new else expression
54 Case e cases ->
55 Case (f e) (map substCase cases)
56 where
57 substCase (pattern, expr) =
58 if Set.member old (Pattern.boundVars pattern)
59 then (pattern, expr)
60 else (pattern, f expr)
62 Data tag values ->
63 Data tag (map f values)
65 Access record field ->
66 Access (f record) field
68 Remove record field ->
69 Remove (f record) field
71 Insert record field value ->
72 Insert (f record) field (f value)
74 Modify record fields ->
75 Modify (f record) (map (second f) fields)
77 Record fields ->
78 Record (map (second f) fields)
80 Literal _ -> expression
82 Markdown _ _ -> expression
84 GLShader _ _ _ -> expression
86 PortIn name st ->
87 PortIn name st
89 PortOut name st signal ->
90 PortOut name st (f signal)