Safe Haskell	None

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