blob: 35a65424b40b7d7aa16f4f01369655c004ae8713 (
plain)
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
|
module Haskell.Env.Cmd where
import Haskell.AST
import Haskell.Rewrite
import Pretty
import Util
data Action = Action RewCmd Name
deriving (Show)
data RewCmd = CRewrite Name
| CBeta
| CEta
| CCase
| CCaseForce
| CEtaCase
| CCaseCase
| CRepeat RewCmd
deriving (Show)
instance Pretty Action where
pretty (Action cmd target) = Node ("action " ++ target) [pretty cmd]
instance Pretty RewCmd where
pretty (CRewrite name) = Leaf ("rew " ++ name)
pretty CBeta = Leaf "beta"
pretty CEta = Leaf "eta"
pretty CCase = Leaf "case"
pretty CCaseForce = Leaf "case!"
pretty CEtaCase = Leaf "etacase"
pretty CCaseCase = Leaf "casecase"
pretty (CRepeat cmd) = Node "repeat" [pretty cmd]
exprTransformer :: RewCmd -> Maybe (Expr -> Expr)
exprTransformer = fmap (normalise .) . exprTransformer'
exprTransformer' :: RewCmd -> Maybe (Expr -> Expr)
exprTransformer' (CRewrite _) = Nothing
exprTransformer' CBeta = Just betared
exprTransformer' CEta = Just etared
exprTransformer' CCase = Just (casered False)
exprTransformer' CCaseForce = Just (casered True)
exprTransformer' CEtaCase = Just etacase
exprTransformer' CCaseCase = Just casecase
exprTransformer' (CRepeat (CRepeat cmd)) = exprTransformer' (CRepeat cmd)
exprTransformer' (CRepeat cmd) = fixpoint <$> exprTransformer' cmd
|
