on ce01547 help sign in
elk/src/Generate/Substitute.hs
103 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Generate.Substitute (subst) where
4import Control.Arrow (second, (***))
6import AST.Expression.General (Expr'(..), PortImpl(..))
7import qualified AST.Expression.Canonical as Canonical
8import qualified AST.Pattern as Pattern
9import qualified AST.Variable as V
10import Elm.Utils ((|>))
11import qualified Reporting.Annotation as A
14subst :: String -> Canonical.Expr' -> Canonical.Expr' -> Canonical.Expr'
15subst old new expression =
16 let f (A.A a e) = A.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 if Pattern.member old pattern
29 then expression
30 else Lambda pattern (f body)
32 App e1 e2 ->
33 App (f e1) (f e2)
35 MultiIf branches ->
36 MultiIf (map (f *** f) branches)
38 Let defs body ->
39 if anyShadow
40 then expression
41 else Let (map substDef defs) (f body)
42 where
43 substDef (Canonical.Definition p e t) =
44 Canonical.Definition p (f e) t
46 anyShadow =
47 map (\(Canonical.Definition p _ _) -> p) defs
48 |> any (Pattern.member old)
50 Var (V.Canonical home x) ->
51 case home of
52 V.Module _ ->
53 expression
55 V.BuiltIn ->
56 expression
58 V.Local ->
59 if x == old then new else expression
61 Case e cases ->
62 Case (f e) (map substCase cases)
63 where
64 substCase (pattern, expr) =
65 if Pattern.member old pattern
66 then (pattern, expr)
67 else (pattern, f expr)
69 Data tag values ->
70 Data tag (map f values)
72 Access record field ->
73 Access (f record) field
75 Remove record field ->
76 Remove (f record) field
78 Insert record field value ->
79 Insert (f record) field (f value)
81 Modify record fields ->
82 Modify (f record) (map (second f) fields)
84 Record fields ->
85 Record (map (second f) fields)
87 Literal _ ->
88 expression
90 GLShader _ _ _ ->
91 expression
93 Port impl ->
94 Port $
95 case impl of
96 In _ _ ->
97 impl
99 Out name expr tipe ->
100 Out name (f expr) tipe
102 Task name expr tipe ->
103 Task name (f expr) tipe