2013-07-01 18:00:37 +00:00
|
|
|
{-# OPTIONS_GHC -Wall #-}
|
2013-06-14 05:45:08 +00:00
|
|
|
module Transform.Substitute (subst) where
|
2012-09-02 05:26:35 +00:00
|
|
|
|
2013-10-13 21:36:21 +00:00
|
|
|
import Control.Arrow (second, (***))
|
2014-02-09 23:17:33 +00:00
|
|
|
import qualified Data.Set as Set
|
|
|
|
|
|
|
|
import SourceSyntax.Annotation
|
2013-06-14 05:45:08 +00:00
|
|
|
import SourceSyntax.Expression
|
2014-01-03 07:23:11 +00:00
|
|
|
import qualified SourceSyntax.Pattern as Pattern
|
2014-02-09 23:17:33 +00:00
|
|
|
import qualified SourceSyntax.Variable as V
|
2012-09-02 05:26:35 +00:00
|
|
|
|
2014-02-09 23:17:33 +00:00
|
|
|
subst :: String -> Expr' -> Expr' -> Expr'
|
2012-09-14 04:31:34 +00:00
|
|
|
subst old new expr =
|
2014-02-09 23:17:33 +00:00
|
|
|
let f (A a e) = A a (subst old new e) in
|
2012-09-02 05:26:35 +00:00
|
|
|
case expr of
|
|
|
|
Range e1 e2 -> Range (f e1) (f e2)
|
2013-07-01 18:00:37 +00:00
|
|
|
ExplicitList es -> ExplicitList (map f es)
|
2012-09-02 05:26:35 +00:00
|
|
|
Binop op e1 e2 -> Binop op (f e1) (f e2)
|
2013-10-13 21:36:21 +00:00
|
|
|
Lambda p e
|
2014-01-03 07:23:11 +00:00
|
|
|
| Set.member old (Pattern.boundVars p) -> expr
|
2013-10-13 21:36:21 +00:00
|
|
|
| otherwise -> Lambda p (f e)
|
2012-09-02 05:26:35 +00:00
|
|
|
App e1 e2 -> App (f e1) (f e2)
|
2012-12-25 08:39:18 +00:00
|
|
|
MultiIf ps -> MultiIf (map (f *** f) ps)
|
2013-10-13 21:36:21 +00:00
|
|
|
|
|
|
|
Let defs body
|
2013-10-15 00:26:47 +00:00
|
|
|
| anyShadow -> expr
|
2013-10-13 21:36:21 +00:00
|
|
|
| otherwise -> Let (map substDef defs) (f body)
|
|
|
|
where
|
2014-01-03 07:23:11 +00:00
|
|
|
substDef (Definition p e t) = Definition p (f e) t
|
2013-10-15 00:26:47 +00:00
|
|
|
anyShadow =
|
2014-01-03 07:23:11 +00:00
|
|
|
any (Set.member old . Pattern.boundVars) [ p | Definition p _ _ <- defs ]
|
2013-10-13 21:36:21 +00:00
|
|
|
|
2014-02-09 23:17:33 +00:00
|
|
|
Var (V.Raw x) -> if x == old then new else expr
|
2012-09-02 05:26:35 +00:00
|
|
|
Case e cases -> Case (f e) $ map (second f) cases
|
|
|
|
Data name es -> Data name (map f es)
|
2013-07-01 18:00:37 +00:00
|
|
|
Access e x -> Access (f e) x
|
|
|
|
Remove e x -> Remove (f e) x
|
|
|
|
Insert e x v -> Insert (f e) x (f v)
|
|
|
|
Modify r fs -> Modify (f r) (map (second f) fs)
|
2013-07-04 15:24:04 +00:00
|
|
|
Record fs -> Record (map (second f) fs)
|
2013-07-01 18:00:37 +00:00
|
|
|
Literal _ -> expr
|
2014-01-04 10:39:38 +00:00
|
|
|
Markdown uid md es -> Markdown uid md (map f es)
|
2014-01-13 18:24:17 +00:00
|
|
|
PortIn name st -> PortIn name st
|
2014-02-09 23:17:33 +00:00
|
|
|
PortOut name st signal -> PortOut name st (f signal)
|