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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
{-|
Module : VeriFuzz.RecursionScheme
Description : Recursion scheme implementation for the AST.
Copyright : (c) 2019, Yann Herklotz Grave
License : GPL-3
Maintainer : ymherklotz [at] gmail [dot] com
Stability : experimental
Portability : POSIX
Recursion scheme implementation for the AST.
-}
module VeriFuzz.RecursionScheme
( Term(..)
, Attr(..)
, Algebra
, bottomUp
, topDown
, cata
, ana
, para
, apo
)
where
import Control.Arrow ((&&&), (>>>), (|||))
import Data.Function ((&))
newtype Term f = In { out :: f (Term f) }
data Attr f a = Attr
{ attribute :: a
, hole :: f (Attr f a)
}
type Algebra f a = f a -> a
type RAlgebra f a = f (Term f, a) -> a
type RAlgebra' f a = Term f -> f a -> a
type CVAlgebra f a = f (Attr f a) -> a
type Coalgebra f a = a -> f a
type RCoalgebra f a = a -> f (Either (Term f) a)
bottomUp :: Functor a => (Term a -> Term a) -> Term a -> Term a
bottomUp fn = cata $ In >>> fn
topDown :: Functor a => (Term a -> Term a) -> Term a -> Term a
topDown fn = ana $ fn >>> out
cata :: Functor f => Algebra f a -> Term f -> a
cata fn = para' $ const fn
ana :: Functor f => Coalgebra f a -> a -> Term f
ana fn =
fn
>>> fmap (ana fn)
>>> In
para :: Functor f => RAlgebra f a -> Term f -> a
para ralg =
out
>>> fmap (id &&& para ralg)
>>> ralg
para' :: Functor f => RAlgebra' f a -> Term f -> a
para' ralg t = out t & fmap (para' ralg) & ralg t
apo :: Functor f => RCoalgebra f a -> a -> Term f
apo rcoalg =
rcoalg
>>> fmap (id ||| apo rcoalg)
>>> In
histo :: Functor f => CVAlgebra f a -> Term f -> a
histo cv =
out
>>> fmap worker
>>> cv
where
worker t = undefined
|
