git.iko.soy/elk
on 2cd0692 help sign in
elk/src/Optimize/Substitute.hs
109 lines 2.8 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 MultiIf branches finally ->
36 MultiIf (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 Remove record field ->
79 Remove (f record) field
81 Insert record field value ->
82 Insert (f record) field (f value)
84 Modify record fields ->
85 Modify (f record) (map (second f) fields)
87 Record fields ->
88 Record (map (second f) fields)
90 Literal _ ->
91 expression
93 GLShader _ _ _ ->
94 expression
96 Port impl ->
97 Port $
98 case impl of
99 In _ _ ->
100 impl
102 Out name expr tipe ->
103 Out name (f expr) tipe
105 Task name expr tipe ->
106 Task name (f expr) tipe
108 Crash _ ->
109 expression