1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
module NameChange (NameChange, ncRenaming, ncResultants, ncFunc, ncExpr) where
import Function (second)
import Maybe (fromMaybe)
import FlatCurry.Types
import PevalBase (FunLhs, Renaming, Resultant)
type NameChange = [(QName, QName)]
ncResultants :: NameChange -> [Resultant] -> [Resultant]
ncResultants nc res = [ (ncFunLhs nc lhs, ncExpr nc e) | (lhs, e) <- res ]
ncRenaming :: NameChange -> Renaming -> Renaming
ncRenaming nc ren = [ (ncExpr nc e, ncFunLhs nc lhs) | (e, lhs) <- ren ]
ncFunLhs :: NameChange -> FunLhs -> FunLhs
ncFunLhs nc (f, vs) = (ncQName nc f, vs)
ncFunc :: NameChange -> FuncDecl -> FuncDecl
ncFunc nc (Func qn a v ty r) = Func (ncQName nc qn) a v ty (ncRule nc r)
ncRule :: NameChange -> Rule -> Rule
ncRule nc (Rule vs e) = Rule vs (ncExpr nc e)
ncRule _ e@(External _) = e
ncExpr :: NameChange -> Expr -> Expr
ncExpr _ v@(Var _) = v
ncExpr _ l@(Lit _) = l
ncExpr nc (Comb ct qn es) = Comb ct (ncQName nc qn) (map (ncExpr nc) es)
ncExpr nc (Let bs e) = Let (map (second (ncExpr nc)) bs) (ncExpr nc e)
ncExpr nc (Free vs e) = Free vs (ncExpr nc e)
ncExpr nc (Or e1 e2) = Or (ncExpr nc e1) (ncExpr nc e2)
ncExpr nc (Case ct e bs) = Case ct (ncExpr nc e) (map (ncBranch nc) bs)
ncExpr nc (Typed e ty) = Typed (ncExpr nc e) ty
ncBranch :: NameChange -> BranchExpr -> BranchExpr
ncBranch nc (Branch p e) = Branch p (ncExpr nc e)
ncQName :: NameChange -> QName -> QName
ncQName nc qn = fromMaybe qn (lookup qn nc)
|