Safe Haskell	None
Language	Haskell2010

Data.Thorn.Fold

Contents

Folding and Unfolding
Examples
- Basic
- Mutual Recursion

Description

The module Data.Thorn.Fold.

Synopsis

Folding and Unfolding

Thorn generates folds and unfolds from various kinds of recursive datatypes, including mutually recursive ones.

unfixdata Source

Arguments

:: TypeQ	`t`, recursive datatype
-> String	`s`, name of the datatype to be declared
-> (String -> String)	`f`, how to convert the name of data constructors
-> [Name]	`ds`, derivings
-> DecsQ	declaration of a nonrecursive datatype whose fixpoint is `t`

unfixdata t n f ds provides a declaration of a nonrecursive datatype whose fixpoint is the recursive type t, with a deriving declaration with names ds.

autofold Source

Arguments

:: TypeQ	`u`, nonrecursive datatype
-> TypeQ	`t`, fixpoint of `u`
-> ExpQ	fold with a type `(u x0 .. xn a -> a) -> (t x0 .. xn -> a)`

autofold u t provides a fold for the recursive type t.

autofoldtype :: TypeQ -> TypeQ -> TypeQ Source

autofoldtype u t provides the type of $(autofold u t), that is, (u x0 .. xn a -> a) -> (t x0 .. xn -> a).

autofolddec :: String -> TypeQ -> TypeQ -> DecsQ Source

autofolddec s u t provides a declaration of a fold for the recursive type t with the name s, with a type signature.

autounfold Source

Arguments

:: TypeQ	`u`, nonrecursive datatype
-> TypeQ	`t`, fixpoint of `u`
-> ExpQ	unfold with a type `(a -> u x0 .. xn a) -> (a -> t x0 .. xn)`

autounfold u t provides an unfold for the recursive type t.

autounfoldtype :: TypeQ -> TypeQ -> TypeQ Source

autounfoldtype u t provides the type of $(autounfold u t), that is, (a -> u x0 .. xn a) -> (a -> t x0 .. xn).

autounfolddec :: String -> TypeQ -> TypeQ -> DecsQ Source

autounfolddec s u t provides a declaration of an unfold for the recursive type t with the name s, with a type signature.

Mutual Recursion

unfixdataMutual Source

Arguments

:: [(TypeQ, String, String -> String, [Name])]	`[(t0,s0,f0,ds0), ...]`; recursive datatype, name of the datatype to be declared, how to convert the name of data constructors, and derivings
-> DecsQ	declarations of datatypes `u0, u1, u2, ...`, whose fixpoints are `t0, t1, t2, ...` respectively

Mutually recursive version of unfixdata. Note that

unfixdata t s f ds = unfixdataMutual [(t,s,f,ds)]

autofoldMutual Source

Arguments

:: [(TypeQ, TypeQ)]	`[(u0,t0), .., (un,tn)]`; `ui` is a nonrecursive datatype and `ti` is a fixpoint of `ui`
-> Int	`k`, index
-> ExpQ	fold with a type `(u0 x0 .. xm a0 .. an -> a0) -> .. -> (un x0 .. xm a0 .. an -> an) -> (tk x0 .. xm -> ak)`

autofoldMutual uts k provides a fold for the mutually recursive type tk.

autofoldtypeMutual :: [(TypeQ, TypeQ)] -> Int -> TypeQ Source

autofoldtypeMutual uts k provides the type of $(autofoldMutual uts k), that is, (u0 x0 .. xm a0 .. an -> a0) -> .. -> (un x0 .. xm a0 .. an -> an) -> (tk x0 .. xm -> ak).

autofolddecMutual :: String -> [(TypeQ, TypeQ)] -> Int -> DecsQ Source

autofolddecMutual s uts k provides a declaration of a fold for the mutually recursive type tk with the name s, with a type signature.

autounfoldMutual Source

Arguments

:: [(TypeQ, TypeQ)]	`[(u0,t0), .., (un,tn)]`; `ui` is a nonrecursive datatype and `ti` is a fixpoint of `ui`
-> Int	`k`, index
-> ExpQ	unfold with a type `(a0 -> u0 x0 .. xm a0 .. an) -> .. -> (an -> un x0 .. xm a0 .. an) -> (ak -> tk x0 .. xm)`

autounfoldMutual uts k provides an unfold for the mutually recursive type tk.

autounfoldtypeMutual :: [(TypeQ, TypeQ)] -> Int -> TypeQ Source

autounfoldtypeMutual uts k provides the type of $(autounfoldMutual uts k), that is, (a0 -> u0 x0 .. xm a0 .. an) -> .. -> (an -> un x0 .. xm a0 .. an) -> (ak -> tk x0 .. xm).

autounfolddecMutual :: String -> [(TypeQ, TypeQ)] -> Int -> DecsQ Source

autounfolddecMutual s uts k provides a declaration of an unfold for the mutually recursive type tk with the name s, with a type signature.

Helper Function

modifynameUf :: String -> String Source

Use this function to designate how to convert the name of data constructors for unfixdata.

modifynameUf "Hello" == "UfHello"
modifynameUf ":***" == ":&***"

Note that

modifynameUf == modifyname ("Uf","") ("&","")

Primitive Functions

autoin Source

Arguments

:: TypeQ	`u`, nonrecursive datatype
-> TypeQ	`t`, fixpoint of `u`
-> ExpQ	function with a type `u x0 .. xn t -> t x0 .. xn`

autoout Source

Arguments

:: TypeQ	`u`, nonrecursive datatype
-> TypeQ	`t`, fixpoint of `u`
-> ExpQ	function with a type `t x0 .. xn -> u x0 .. xn t`

autohylo Source

Arguments

:: TypeQ	`u`, nonrecursive datatype
-> ExpQ	function with a type `(a -> u x0 .. xn a) -> (u x0 .. xn b -> b) -> (a -> b)`

autoinMutual Source

Arguments

:: [(TypeQ, TypeQ)]	`[(u0,t0), .., (un,tn)]`; `ui` is a nonrecursive datatype and `ti` is a fixpoint of `ui`
-> Int	`k`, index
-> ExpQ	function with a type `uk x0 .. xm t0 .. tn -> tk x0 .. xm`

Mutually recursive version of autoin.

autooutMutual Source

Arguments

:: [(TypeQ, TypeQ)]	`[(u0,t0), .., (un,tn)]`; `ui` is a nonrecursive datatype and `ti` is a fixpoint of `ui`
-> Int	`k`, index
-> ExpQ	function with a type `tk x0 .. xm -> uk x0 .. xm t0 .. tn`

Mutually recursive version of autoout.

autohyloMutual Source

Arguments

:: [TypeQ]	`[u0, .., un]`; `ui` is a nonrecursive datatype
-> Int	`k`, index
-> ExpQ	function with a type `(a0 -> u0 x0 .. xm a0 .. an) -> .. -> (an -> un x0 .. xm a0 .. an) -> (u0 x0 .. xm b0 .. bn -> b0) -> .. -> (un x0 .. xm b0 .. bn -> bn) -> (ak -> bk)`

Mutually recursive version of autohylo.

Examples

Basic

It's a piece of cake.

Note tht foldlist is analogous with foldr and unfoldlist with unfoldr.

data List a = Nil | a :* (List a) deriving Show

unfixdata [t|List|] "UfList" modifynameUf [''Show]
-- data UfList a self = UfNil | a :&* self deriving Show

autofolddec "foldlist" [t|UfList|] [t|List|]
autounfolddec "unfoldlist" [t|UfList|] [t|List|]

fib :: List Int
fib = unfoldlist go (0,1)
      -- 1 :* (1 :* (2 :* (3 :* (5 :* (8 :* (13 :* Nil))))))
    where go :: (Int,Int) -> UfList Int (Int,Int)
          go (a,b)
            | b > 20 = UfNil
            | otherwise = b :&* (b,a+b)

fibsum :: Int
fibsum = foldlist add fib
         -- 33
    where add :: UfList Int Int -> Int
          add UfNil = 0
          add (m :&* n) = m+n

normalfib :: [Int]
normalfib = foldlist go fib
            -- [1,1,2,3,5,8,13]
    where go :: UfList a [a] -> [a]
          go UfNil = []
          go (a :&* as) = a:as

Mutual Recursion

It also works for mutual recursion.

It's just an extension of simple recursion. Take it easy.

data Rose x = x :-< (Forest x) deriving Show
data Forest x = F [Rose x] deriving Show

unfixdataMutual [([t|Rose|],"UfRose",modifynameUf,[''Show]), ([t|Forest|],"UfForest",modifynameUf,[''Show])]
-- data UfRose x rose forest = x :&-< forest deriving Show
-- data UfForest x rose forest = UfF [rose] deriving Show

autofolddecMutual "foldrose" [([t|UfRose|],[t|Rose|]),([t|UfForest|],[t|Forest|])] 0
-- foldrose :: (UfRose x a b -> a) -> (UfForest x a b -> b) -> Rose x -> a
-- foldrose = ...
autounfolddecMutual "unfoldrose" [([t|UfRose|],[t|Rose|]),([t|UfForest|],[t|Forest|])] 0
-- unfoldrose :: (a -> UfRose x a b) -> (b -> UfForest x a b) -> a -> Rose x
-- unfoldrose = ...

rose :: Rose Int
rose = unfoldrose gorose goforest 0
       -- 0 :-< F [1 :-< F [3 :-< F [],4 :-< F []],2 :-< F [5 :-< F [],6 :-< F []]]
    where gorose :: Int -> UfRose Int Int Int
          gorose n
            | n > 2 = n :&-< (-1)
            | otherwise = n :&-< n
          goforest :: Int -> UfForest Int Int Int
          goforest (-1) = UfF []
          goforest n = UfF [n*2+1,n*2+2]

showrose :: Show x => Rose x -> String
showrose = unlines . foldrose gorose goforest
    where gorose :: Show x => UfRose x [String] [String] -> [String]
          gorose (x :&-< ls) = [show x] ++ ls
          goforest :: UfForest x [String] [String] -> [String]
          goforest (UfF []) = []
          goforest (UfF lss) = concatMap hang (init lss) ++ hang' (last lss)
          hang ls = ["|"] ++ ["+--" ++ head ls] ++ map ("|  "++) (tail ls)
          hang' ls = ["|"] ++ ["+--" ++ head ls] ++ map ("   "++) (tail ls)

shownrose :: String
shownrose = showrose rose
-- 0
-- |
-- +--1
-- |  |
-- |  +--3
-- |  |
-- |  +--4
-- |
-- +--2
--    |
--    +--5
--    |
--    +--6