{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where import Language.Grammars.AspectAG import Language.Grammars.AspectAG.Derive import Data.HList.Label4 import Data.HList.TypeEqGeneric1 import Data.HList.TypeCastGeneric1 --data types------------------------------------------------------------------- data Root = Root { tree :: Tree} deriving Show data Tree = Node {l::Tree, r::Tree} | Leaf {i::Int} deriving Show $(deriveAG ''Root) --repmin----------------------------------------------------------------------- $(attLabels ["smin","ival","sres"]) asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil ) ( p_Leaf .=. (\(Fam _ _ chi _) -> chi # ch_i) .*. emptyRecord ) asp_ival f = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) ( p_Root .=. (\(Fam _ _ chi _) -> ( ch_tree .=. f (chi # ch_tree) .*. emptyRecord ) ) .*. p_Node .=. (\(Fam _ _ _ par) -> ( ch_l .=. (par # ival) + 1 -- difference with repmin (doesn't apply copy rule for ch_l) .*. emptyRecord ) ) .*. emptyRecord ) asp_sres () = synAspect sres ( nt_Root .*. nt_Tree .*. hNil ) Node (Leaf 0) ( p_Node .*. hNil ) ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres) .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # ival)) .*. emptyRecord ) asp_repmin () = asp_smin () .+. asp_sres () .+. asp_ival (\c -> c # smin) repmin tree = sem_Root (asp_repmin ()) (Root tree) () # sres ----example-------------------------------------------------------------------- examplet = (Node (Node (Node (Leaf 1) (Leaf 4)) (Node (Leaf 2) (Leaf 1)) ) (Node (Node (Leaf 9) (Leaf 8)) (Leaf 6) ) ) res_repmin = repmin examplet