module AI.Heukarya.Gene.Dynamic(
evalTreeGene
,geneTypeRep
,geneHTypes
,outputHTreeType
,toDyn
,fromDyn
,fromDynamic
,dynApp
,dynApply
,dynTypeRep
) where
import AI.Heukarya.Gene
import qualified Data.Dynamic as D
import Data.List
import Data.Typeable
import Data.Maybe
import Data.Tree
import Control.DeepSeq
import Data.Text(Text,append,pack,unpack)
instance HeukaryaGene Dynamic where
evalTreeGene tree =
foldl dynApp (rootLabel tree) (map evalTreeGene (subForest tree))
geneTypeRep = (pack.show.dynTypeRep)
geneHTypes dynam = hType (lengthType dynam) (dynTypeRep dynam) [] []
where
hType n ty i res = let splited = typeRepArgs ty in
if n == 0
then reverse $ map (\(x,y)->(map (pack.show) $ reverse x,(pack.show) y)) res
else hType (n1) (last splited) (head splited:i) ((i,ty):res)
outputHTreeType tree = snd $ geneHTypes (rootLabel tree)!!length (subForest tree)
instanceOf _ = (==)
lengthType = length.expandType.dynTypeRep
expandType x =
head splited : if length splited < 2 then [] else expandType (last splited)
where
splited = typeRepArgs x
data Dynamic = Dynamic {dynSym::Text, dyn::D.Dynamic}
toDyn sym a = Dynamic sym (D.toDyn a)
fromDyn (Dynamic _ a) b =
D.fromDyn a b
fromDynamic (Dynamic _ a) =
D.fromDynamic a
dynApply (Dynamic syma a) (Dynamic symb b) =
if isNothing (D.dynApply a b) then Nothing else Just ( Dynamic
("(" `append` syma `append` " " `append` symb `append` ")") (D.dynApp a b)
)
dynApp (Dynamic syma a) (Dynamic symb b) =
Dynamic
("(" `append` syma `append` " " `append` symb `append` ")") (D.dynApp a b)
dynTypeRep (Dynamic _ a) =
D.dynTypeRep a
instance Show Dynamic where
show (Dynamic sym _) = unpack sym
instance Eq Dynamic where
(Dynamic syma a) == (Dynamic symb b) = syma == symb
instance Ord Dynamic where
(Dynamic syma a) <= (Dynamic symb b) = syma <= symb
instance NFData Dynamic where