-- Alexey Rodriguez Yakushev import Trex -- module MinTree data Root = Root Tree deriving Show data Tree = Branch Tree Tree | Leaf Int deriving Show -- where is this cata generated? Maybe where the knit is used {- cata :: (a\rootRoot, a\treeBranch, a\treeLeaf) => Rec (treeBranch :: Rec (p1 :: b, p2 :: b) -> b ,treeLeaf :: Rec (p1 :: c -> Rec (terminal :: Int)) -> b ,rootRoot :: Rec (p1 :: b) -> d | a) -> Rec (root :: Root -> d, tree :: Tree -> b) -} cata semFun = matcher where matcherRoot (Root t) = #rootRoot semFun (p1=(matcherTree t)) matcherTree (Branch l r) = #treeBranch semFun (p1=(matcherTree l),p2=(matcherTree r)) matcherTree (Leaf i) = #treeLeaf semFun (p1=(const (terminal = i))) matcher = (root = matcherRoot,tree = matcherTree) -- module MinSyn treeLeaf1 () = \ (pi,cs) (psI,ciI) -> let ps = (minSyn = #terminal (#p1 cs)|psI) in (ps,ciI) treeBranch1 () = \ (pi,cs) (psI,ciI) -> let ps = (minSyn = #minSyn (#p1 cs) `min` #minSyn (#p2 cs)|psI) in (ps,ciI) {- minTree :: (a\minSyn, b\p1, c\terminal, Ord d, e\p2, f\minSyn, e\p1, g\minSyn, h\minSyn) => () -> Rec (treeBranch :: (i,Rec (p2 :: Rec (minSyn :: d | f) ,p1 :: Rec (minSyn :: d | g) | e)) -> (Rec h,j) -> (Rec (minSyn :: d | h),j) ,treeLeaf :: (k,Rec (p1 :: Rec (terminal :: l | c) | b)) -> (Rec a,m) -> (Rec (minSyn :: l | a),m)) -} minTree () = (treeLeaf = treeLeaf1(),treeBranch = treeBranch1()) -- module MinInh rootRoot2 () = \ (pi,cs) (psI,(p1=p1I|ciI)) -> let ci = (p1 = (minInh = #minSyn (#p1 cs)|p1I)|ciI) in (psI,ci) treeLeaf2 () = \ (pi,cs) (psI,ciI) -> (psI,ciI) treeBranch2 () = \ (pi,cs) (psI,(p1=p1I,p2=p2I|ciI)) -> let ci = (p1 = (minInh = #minInh pi|p1I) ,p2 = (minInh = #minInh pi|p2I) |ciI) in (psI,ci) {- propMinTree :: (a\p1, b\minInh, c\minInh, a\p2, d\minInh, e\minInh, f\p1, g\minSyn, h\p1) => () -> Rec (rootRoot :: (i,Rec (p1 :: Rec (minSyn :: j | g) | f)) -> (k,Rec (p1 :: Rec e | h)) -> (k,Rec (p1 :: Rec (minInh :: j | e) | h)) ,treeBranch :: (Rec (minInh :: l | c),m) -> (n,Rec (p1 :: Rec d, p2 :: Rec b | a)) -> (n,Rec (p1 :: Rec (minInh :: l | d) ,p2 :: Rec (minInh :: l | b) | a)) ,treeLeaf :: (o,p) -> (q,r) -> (q,r)) -} propMinTree () = (rootRoot = rootRoot2(), treeLeaf = treeLeaf2(),treeBranch = treeBranch2()) -- module MinGen rootRoot3 () = \ (pi,cs) (psI,ciI) -> let ps = (tree = #tree (#p1 cs)|psI) in (ps,ciI) treeLeaf3 () = \ (pi,cs) (psI,ciI) -> let ps = (tree = Leaf (#minInh pi)|psI) in (ps,ciI) treeBranch3 () = \ (pi,cs) (psI,ciI) -> let ps = (tree = Branch (#tree (#p1 cs)) (#tree (#p2 cs))|psI) in (ps,ciI) {- repMin :: (a\tree, b\tree, c\p1, d\tree, c\p2, e\minInh, f\tree, g\tree, h\p1, i\tree) => () -> Rec (rootRoot :: (j,Rec (p1 :: Rec (tree :: k | g) | h)) -> (Rec i,l) -> (Rec (tree :: k | i),l) ,treeBranch :: (m,Rec (p2 :: Rec (tree :: Tree | d) ,p1 :: Rec (tree :: Tree | b) | c)) -> (Rec a,n) -> (Rec (tree :: Tree | a),n) ,treeLeaf :: (Rec (minInh :: Int | e),o) -> (Rec f,p) -> (Rec (tree :: Tree | f),p)) -} repMin () = (rootRoot = rootRoot3(), treeLeaf = treeLeaf3(),treeBranch = treeBranch3()) -- module MinRepMin cbRule rule1 rule2 inputFamily = rule1 inputFamily . rule2 inputFamily knitRule1 rule childSemFuns inherited = synthesised where (synthesised,childInherited) = rule (inherited,childSynthesised) (EmptyRec,(p1=EmptyRec)) childSynthesised = apply1 childSemFuns childInherited apply1 (p1 = f) (p1 = ci) = (p1 = f ci) knitRule2 rule childSemFuns inherited = synthesised where (synthesised,childInherited) = rule (inherited,childSynthesised) (EmptyRec,(p1=EmptyRec,p2=EmptyRec)) childSynthesised = apply2 childSemFuns childInherited apply2 (p1 = f1,p2 = f2) (p1 = ci1,p2 = ci2) = (p1 = f1 ci1,p2 = f2 ci2) {- ag :: (a\p1, b\minInh, c\minInh, a\p2, d\minInh, e\minInh, f\p1, g\minSyn ,h\p1, i\minSyn, j\minSyn, k\p1, l\minSyn, k\p2, Ord m, n\terminal ,o\p1, p\minSyn, q\tree, g\tree, p\tree, r\minInh, l\tree, j\tree, i\tree) => () -> Rec (rootRoot :: (s,Rec (p1 :: Rec (tree :: t, minSyn :: u | g) | f)) -> (Rec q,Rec (p1 :: Rec e | h)) -> (Rec (tree :: t | q),Rec (p1 :: Rec (minInh:: u | e) | h)) ,treeBranch :: (Rec (minInh :: v | c),Rec (p2 :: Rec (tree :: Tree, minSyn :: m | l) ,p1 :: Rec (tree :: Tree, minSyn :: m | j) | k)) -> (Rec i,Rec (p1 :: Rec d, p2 :: Rec b | a)) -> (Rec (minSyn :: m, tree :: Tree | i),Rec (p1 :: Rec (minInh :: v | d) ,p2 :: Rec (minInh :: v | b) | a)) ,treeLeaf :: (Rec (minInh :: Int | r),Rec (p1 :: Rec (terminal :: w | n) | o)) -> (Rec p,x) -> (Rec (minSyn :: w, tree :: Tree | p),x)) -} ag () = (rootRoot = #rootRoot propMinTree' `cbRule` #rootRoot repMin' ,treeLeaf = #treeLeaf minTree' `cbRule` #treeLeaf propMinTree' `cbRule` #treeLeaf repMin' ,treeBranch = #treeBranch minTree' `cbRule` #treeBranch propMinTree' `cbRule` #treeBranch repMin') where minTree' = minTree() propMinTree' = propMinTree() repMin' = repMin() {- knittedAG :: (a\tree, b\tree, c\minInh, d\tree, e\terminal, Ord f, b\minSyn, a\minSyn, d\minSyn, g\minInh) => () -> Rec (rootRoot :: Rec (p1 :: Rec (minInh :: h) -> Rec (tree :: i, minSyn :: h | d)) -> j -> Rec (tree :: i) , treeBranch :: Rec (p1 :: Rec (minInh :: k) -> Rec (tree :: Tree, minSyn :: f | a) ,p2 :: Rec (minInh :: k) -> Rec (tree :: Tree, minSyn :: f | b)) -> Rec (minInh :: k | g) -> Rec (minSyn :: f, tree :: Tree) , treeLeaf :: Rec (p1 :: Rec EmptyRow -> Rec (terminal :: l | e)) -> Rec (minInh :: Int | c) -> Rec (minSyn :: l, tree :: Tree)) -} knittedAG () = (rootRoot = knitRule1 (#rootRoot ag') ,treeLeaf = knitRule1 (#treeLeaf ag') ,treeBranch = knitRule2 (#treeBranch ag')) where ag' = ag() {- semFuns :: Rec (root :: Root -> a -> Rec (tree :: Tree) ,tree :: Tree -> Rec (minInh :: Int) -> Rec (tree :: Tree, minSyn ::Int)) -} semFuns = cata (knittedAG ()) rootAGFun = #root semFuns exampleTree = Root (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 7)) exampleResult = #tree (rootAGFun exampleTree ())