diff options
Diffstat (limited to 'src/VeriFuzz/RecursionScheme.hs')
-rw-r--r-- | src/VeriFuzz/RecursionScheme.hs | 70 |
1 files changed, 0 insertions, 70 deletions
diff --git a/src/VeriFuzz/RecursionScheme.hs b/src/VeriFuzz/RecursionScheme.hs deleted file mode 100644 index e0807ad..0000000 --- a/src/VeriFuzz/RecursionScheme.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-| -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 |