----------------------------------------------------------------------------- -- | -- Module : Data.Default -- Copyright : (c) 2010 University of Minho -- License : BSD3 -- -- Maintainer : hpacheco@di.uminho.pt -- Stability : experimental -- Portability : non-portable -- -- Pointless Rewrite: -- automatic transformation system for point-free programs -- -- Type-safe representation of types and point-free expressions at the value level, including -- representation of recursive types as fixpoints of functors. -- ----------------------------------------------------------------------------- module Data.Default where import Data.Type import Data.Spine import Generics.Pointless.Functors type Generator = forall a. Type a -> a type GeneratorF = forall f a. Fctr f -> Type a -> Rep f a -- | Default generator for representable types defvalue :: Generator defvalue Int = 0 defvalue Bool = False defvalue Char = ' ' defvalue (Prod a b) = (defvalue a,defvalue b) defvalue (Either a b) = Left $ defvalue a defvalue (List a) = [] defvalue a@(Data _ f) = inn $ defvalueF f a defvalue a@(NewData _ f) = Inn $ defvalueF f a defvalue a = error $ "no default generator for " ++ show a -- | Default generator for representable functor types -- important to deal with recursive occurences to avoid infinite values defvalueF :: GeneratorF defvalueF I a = defvalue a defvalueF L a = [] defvalueF (K c) a = defvalue c defvalueF (f :*!: g) a = (defvalueF f a,defvalueF g a) defvalueF (f :+!: g) a = if (countId f <= countId g) then Left (defvalueF f a) else Right (defvalueF g a) defvalueF (I :@!: g) a = defvalueF g a defvalueF (K c :@!: g) a = defvalue c defvalueF (L :@!: g) a = [] defvalueF ((f :*!: g) :@!: h) a = defvalueF ((f :@!: h) :*!: (g :@!: h)) a defvalueF ((f :+!: g) :@!: h) a = defvalueF ((f :@!: h) :+!: (g :@!: h)) a defvalueF ((f :@!: g) :@!: h) a = defvalueF (f :@!: (g :@!: h)) a -- | Counts the number of recursive invocations in a functor countId :: Fctr f -> Int countId I = 1 countId (K c) = 0 countId L = 0 countId (f :*!: g) = countId f + countId g countId (f :+!: g) = min (countId f) (countId g) countId (I :@!: g) = countId g countId (K c :@!: g) = 0 countId (L :@!: g) = 0 -- as long as we return the empty list, there is no problem with recursive invocations countId ((f :*!: g) :@!: h) = countId ((f :@!: h) :*!: (g :@!: h)) countId ((f :+!: g) :@!: h) = countId ((f :@!: h) :+!: (g :@!: h)) countId ((f :@!: g) :@!: h) = countId (f :@!: (g :@!: h))