on ff98144 help sign in
elk/src/Optimize/Substitute.hs
103 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Optimize.Substitute (subst) where
4import Control.Arrow (second, (***))
6import AST.Expression.General (Expr'(..), PortImpl(..))
7import qualified AST.Expression.Optimized as Optimized
8import qualified AST.Pattern as Pattern
9import qualified AST.Variable as V
10import Elm.Utils ((|>))
11import qualified Reporting.Annotation as A
14subst :: String -> Optimized.Expr' -> Optimized.Expr' -> Optimized.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 lo hi ->
19 Range (f lo) (f hi)
21 ExplicitList exprs ->
22 ExplicitList (map f exprs)
24 Binop op left right ->
25 Binop op (f left) (f right)
27 Lambda pattern body ->
28 if Pattern.member old pattern
29 then expression
30 else Lambda pattern (f body)
32 App func arg ->
33 App (f func) (f arg)
35 If branches finally ->
36 If (map (f *** f) branches) (f finally)
38 Let defs body ->
39 if anyShadow
40 then expression
41 else Let (map substDef defs) (f body)
42 where
43 substDef (Optimized.Definition facts pattern expr) =
44 Optimized.Definition facts pattern (f expr)
46 anyShadow =
47 map (\(Optimized.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 V.TopLevel _ ->
62 if x == old then new else expression
64 Case e cases ->
65 Case (f e) (map substCase cases)
66 where
67 substCase (pattern, expr) =
68 if Pattern.member old pattern
69 then (pattern, expr)
70 else (pattern, f expr)
72 Data tag values ->
73 Data tag (map f values)
75 Access record field ->
76 Access (f record) field
78 Update record fields ->
79 Update (f record) (map (second f) fields)
81 Record fields ->
82 Record (map (second f) fields)
84 Literal _ ->
85 expression
87 GLShader _ _ _ ->
88 expression
90 Port impl ->
91 Port $
92 case impl of
93 In _ _ ->
94 impl
96 Out name expr tipe ->
97 Out name (f expr) tipe
99 Task name expr tipe ->
100 Task name (f expr) tipe
102 Crash _ ->
103 expression