git.iko.soy/elk
on cb3a2fa help sign in
elk/src/Optimize/Substitute.hs
106 lines 2.7 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 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
105 Crash _ ->
106 expression