diff --git a/AspectAG.cabal b/AspectAG.cabal --- a/AspectAG.cabal +++ b/AspectAG.cabal @@ -1,5 +1,5 @@ name: AspectAG -version: 0.1.1 +version: 0.1.2 license: LGPL license-file: COPYRIGHT maintainer: Marcos Viera @@ -10,14 +10,13 @@ category: Development stability: Experimental copyright: Universiteit Utrecht -build-depends: base<=4, haskell98, template-haskell, HList>=0.1.1, containers>=0.2.0.0, mtl>=1.1.0.2 +build-depends: base<=4, haskell98, template-haskell, HList>=0.2, containers>=0.2.0.0, mtl>=1.1.0.2 cabal-version: >= 1.2.3 exposed-modules: Data.AspectAG, Data.AspectAG.Derive other-modules: -extensions: MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, - UndecidableInstances, ExistentialQuantification, EmptyDataDecls, Rank2Types, - TypeSynonymInstances - +extensions: EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, + MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, + TypeSynonymInstances, UndecidableInstances, GADTs hs-source-dirs: src extra-source-files: README, LICENSE-LGPL ghc-options: -Wall diff --git a/examples/.svn/all-wcprops b/examples/.svn/all-wcprops new file mode 100644 --- /dev/null +++ b/examples/.svn/all-wcprops @@ -0,0 +1,89 @@ +K 25 +svn:wc:ra_dav:version-url +V 63 +/repos/staff.doaitse.mviera/!svn/ver/100/fcag/AspectAG/examples +END +repminM.hs +K 25 +svn:wc:ra_dav:version-url +V 73 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/repminM.hs +END +repmin.hs +K 25 +svn:wc:ra_dav:version-url +V 72 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/repmin.hs +END +test1TH.hs +K 25 +svn:wc:ra_dav:version-url +V 73 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test1TH.hs +END +test2TH.hs +K 25 +svn:wc:ra_dav:version-url +V 73 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test2TH.hs +END +test3TH.hs +K 25 +svn:wc:ra_dav:version-url +V 73 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test3TH.hs +END +calcM.hs +K 25 +svn:wc:ra_dav:version-url +V 71 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/calcM.hs +END +test4TH.hs +K 25 +svn:wc:ra_dav:version-url +V 73 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test4TH.hs +END +test1.hs +K 25 +svn:wc:ra_dav:version-url +V 71 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test1.hs +END +test5TH.hs +K 25 +svn:wc:ra_dav:version-url +V 73 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test5TH.hs +END +test2.hs +K 25 +svn:wc:ra_dav:version-url +V 71 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test2.hs +END +calc.hs +K 25 +svn:wc:ra_dav:version-url +V 70 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/calc.hs +END +test3.hs +K 25 +svn:wc:ra_dav:version-url +V 71 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test3.hs +END +test4.hs +K 25 +svn:wc:ra_dav:version-url +V 71 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test4.hs +END +test5.hs +K 25 +svn:wc:ra_dav:version-url +V 71 +/repos/staff.doaitse.mviera/!svn/ver/92/fcag/AspectAG/examples/test5.hs +END diff --git a/examples/.svn/entries b/examples/.svn/entries new file mode 100644 --- /dev/null +++ b/examples/.svn/entries @@ -0,0 +1,196 @@ +8 + +dir +103 +https://subversion.cs.uu.nl/repos/staff.doaitse.mviera/fcag/AspectAG/examples +https://subversion.cs.uu.nl/repos/staff.doaitse.mviera + + + +2009-07-07T01:21:27.227217Z +100 +mviera + + +svn:special svn:externals svn:needs-lock + + + + + + + + + + + +797e81ee-af45-11dd-a060-e3cdf63a9eb3 + +repminM.hs +file + + + + +2009-08-04T13:07:04.000000Z +3c104f2568fc2aedf039f3b7cddcb003 +2009-06-06T23:16:15.819224Z +92 +mviera + +repmin.hs +file + + + + +2009-08-04T13:07:04.000000Z +08a2103bb251697245aa1a2d3d5b987c +2009-06-06T23:16:15.819224Z +92 +mviera + +test1TH.hs +file + + + + +2009-08-04T13:07:04.000000Z +aec66e222bb40fb113ecc855b350b9c6 +2009-06-06T23:16:15.819224Z +92 +mviera + +test2TH.hs +file + + + + +2009-08-04T13:07:04.000000Z +0d38f14e37b7da77f807f870dd8eecd1 +2009-06-06T23:16:15.819224Z +92 +mviera + +test3TH.hs +file + + + + +2009-08-04T13:07:04.000000Z +7afd61e067d0641da0d4281605f37bb7 +2009-06-06T23:16:15.819224Z +92 +mviera + +calcM.hs +file + + + + +2009-08-04T13:07:04.000000Z +a9fd27aedc884f8cc85fdca5cc5052de +2009-06-06T23:16:15.819224Z +92 +mviera + +test4TH.hs +file + + + + +2009-08-04T13:07:04.000000Z +17763948759701cbe4a75727c93858e4 +2009-06-06T23:16:15.819224Z +92 +mviera + +test1.hs +file + + + + +2009-08-04T13:07:04.000000Z +38e9f2b25faab0df5b4578d314c7d77e +2009-06-06T23:16:15.819224Z +92 +mviera + +test5TH.hs +file + + + + +2009-08-04T13:07:04.000000Z +3b4a6bc49499de277d7ffaf863a57f55 +2009-06-06T23:16:15.819224Z +92 +mviera + +test2.hs +file + + + + +2009-08-04T13:07:04.000000Z +57de1b3954f9cd6b4cf1c1ead16e2718 +2009-06-06T23:16:15.819224Z +92 +mviera + +calc.hs +file + + + + +2009-08-04T13:07:04.000000Z +fb90204f9fc24051d897f601083f8379 +2009-06-06T23:16:15.819224Z +92 +mviera + +test3.hs +file + + + + +2009-08-04T13:07:04.000000Z +d8460ba6cd09b9c999e037647c80139e +2009-06-06T23:16:15.819224Z +92 +mviera + +test4.hs +file + + + + +2009-08-04T13:07:04.000000Z +7e247f5df6dac68e932a4fc0f2a21a4b +2009-06-06T23:16:15.819224Z +92 +mviera + +test5.hs +file + + + + +2009-08-04T13:07:04.000000Z +7851fee4d2d7fb66183fc1f5fb20a18f +2009-06-06T23:16:15.819224Z +92 +mviera + diff --git a/examples/.svn/format b/examples/.svn/format new file mode 100644 --- /dev/null +++ b/examples/.svn/format @@ -0,0 +1,1 @@ +8 diff --git a/examples/.svn/text-base/calc.hs.svn-base b/examples/.svn/text-base/calc.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/calc.hs.svn-base @@ -0,0 +1,80 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Calc where + +import Data.AspectAG +import Data.AspectAG.Derive + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + +import UU.Pretty hiding (par) + +--data types------------------------------------------------------------------- + +data AGItf = AGItf { expr :: Expr} + deriving Show + +data Expr = IConst {int::Int} + | Add {e1::Expr, e2::Expr} + | Let {lnm::String, val::Expr, body::Expr} + | Var {vnm::String} + deriving Show + + +$(deriveAG ''AGItf) + + +allNT = nt_AGItf .*. nt_Expr .*. hNil + +------------------------------------------------------------------------------- + + +$(attLabel "spp") + +asp_spp () = synAspect spp allNT ((>|<)::PP_Doc->PP_Doc->PP_Doc) (empty::PP_Doc) ( p_AGItf .*. hNil ) + ( p_IConst .=. (\(Fam chi _) -> pp (chi # ch_int)) + .*. p_Add .=. (\(Fam chi _) -> ((chi # ch_e1) # spp) >|< "+" >|< ((chi # ch_e2) # spp)) + .*. p_Var .=. (\(Fam chi _) -> pp (chi # ch_vnm)) + .*. p_Let .=. (\(Fam chi _) -> "[" >|< (chi # ch_lnm) >|< "=" >|< + ((chi # ch_val) # spp) >|< ":" >|< ((chi # ch_body) # spp) >|< "]") + .*. emptyRecord ) + + +$(attLabels ["ienv","sval"]) + +asp_ienv () = inhAspect ienv ( nt_Expr .*. hNil ) ( p_Add .*. p_Let .*. hNil ) + ( p_Let .=. (\(Fam chi par) -> ( ch_body .=. ((chi # ch_lnm), ((chi # ch_val) # sval)) : (par # ienv) + .*. emptyRecord)) + .*. p_AGItf .=. (\(Fam chi _) -> ( ch_expr .=. ([] :: [(String,Int)]) + .*. emptyRecord)) + .*. emptyRecord ) + +asp_sval () = synAspect sval allNT ((+)::Int->Int->Int) (0::Int) ( p_AGItf .*. p_Add .*. hNil ) + ( p_IConst .=. (\(Fam chi _) -> chi # ch_int) + .*. p_Var .=. (\(Fam chi par) -> maybe 0 id (lookup (chi # ch_vnm) (par # ienv))) + .*. p_Let .=. (\(Fam chi _) -> (chi # ch_body) # sval) + .*. emptyRecord ) + + +$(attLabel "ccount") + + +asp_ccount () = chnAspect ccount allNT ( p_AGItf .*. p_IConst .*. p_Add .*. p_Let .*. p_Var .*. hNil ) + emptyRecord + ( p_Add .=. (\(Fam chi _) -> ((chi # ch_e2) # ccount) + 1 ) + .*. emptyRecord ) + + +----example-------------------------------------------------------------------- + + +ex = Let "x" (Add (Add (IConst 2) (IConst 3)) (IConst 1)) (Add (Var "x") (Var "x")) + + +expp = sem_AGItf (asp_spp ()) (AGItf ex) () # spp +exval = sem_AGItf (asp_sval () .+. asp_ienv ()) (AGItf ex) () # sval +excnt = sem_AGItf (asp_ccount ()) (AGItf ex) (ccount .=. 0 .*. emptyRecord) # ccount + diff --git a/examples/.svn/text-base/calcM.hs.svn-base b/examples/.svn/text-base/calcM.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/calcM.hs.svn-base @@ -0,0 +1,96 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Calc where + +import Data.AspectAG +import Data.AspectAG.Derive + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + +import UU.Pretty hiding (par) + + +--data types------------------------------------------------------------------- + +data AGItf = AGItf { expr :: Expr} + deriving Show + +data Expr = IConst {int::Int} + | Add {e1::Expr, e2::Expr} + | Let {lnm::String, val::Expr, body::Expr} + | Var {vnm::String} + deriving Show + + +$(deriveAG ''AGItf) + + +allNT = nt_AGItf .*. nt_Expr .*. hNil + +------------------------------------------------------------------------------- + +$(attLabel "spp") + +asp_spp () = synAspect spp allNT ((>|<)::PP_Doc->PP_Doc->PP_Doc) (empty::PP_Doc) ( p_AGItf .*. hNil ) + ( p_IConst .=. (def $ do int <- at ch_int + return $ pp int ) + .*. p_Add .=. (def $ do e1 <- at ch_e1 + e2 <- at ch_e2 + return $ (e1 # spp) >|< "+" >|< (e2 # spp) ) + .*. p_Var .=. (def $ do vnm <- at ch_vnm + return $ pp vnm ) + .*. p_Let .=. (def $ do lnm <- at ch_lnm + val <- at ch_val + body <- at ch_body + return $ "[" >|< lnm >|< "=" >|< (val # spp) >|< ":" >|< (body # spp) >|< "]") + .*. emptyRecord ) + + +$(attLabels ["ienv","sval"]) + + +asp_ienv () = inhAspect ienv ( nt_Expr .*. hNil ) ( p_Add .*. p_Let .*. hNil ) + ( p_Let .=. (def $ do lnm <- at ch_lnm + val <- at ch_val + lhs <- at lhs + return ( ch_body .=. ((lnm, val # sval) : (lhs # ienv)) + .*. emptyRecord)) + .*. p_AGItf .=. (def $ do return ( ch_expr .=. ([] :: [(String,Int)]) + .*. emptyRecord)) + + .*. emptyRecord ) + +asp_sval () = synAspect sval allNT ((+)::Int->Int->Int) (0::Int) ( p_AGItf .*. p_Add .*. hNil ) + ( p_IConst .=. (def $ do int <- at ch_int + return int) + .*. p_Var .=. (def $ do vnm <- at ch_vnm + lhs <- at lhs + return $ maybe 0 id (lookup vnm (lhs # ienv))) + .*. p_Let .=. (def $ do body <- at ch_body + return $ body # sval) + .*. emptyRecord ) + + +$(attLabel "ccount") + + +asp_ccount () = chnAspect ccount allNT ( p_AGItf .*. p_IConst .*. p_Add .*. p_Let .*. p_Var .*. hNil ) + emptyRecord + ( p_Add .=. (def $ do e2 <- at ch_e2 + return $ (e2 # ccount) + 1 ) + .*. emptyRecord ) + + +----example-------------------------------------------------------------------- + + +ex = Let "x" (Add (Add (IConst 2) (IConst 3)) (IConst 1)) (Add (Var "x") (Var "x")) + + +expp = sem_AGItf (asp_spp ()) (AGItf ex) () # spp +exval = sem_AGItf (asp_sval () .+. asp_ienv ()) (AGItf ex) () # sval +excnt = sem_AGItf (asp_ccount ()) (AGItf ex) (ccount .=. 0 .*. emptyRecord) # ccount + diff --git a/examples/.svn/text-base/repmin.hs.svn-base b/examples/.svn/text-base/repmin.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/repmin.hs.svn-base @@ -0,0 +1,69 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Repmin where + +import Data.AspectAG +import Data.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 () = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. (chi # ch_tree) # smin + .*. 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 () + +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 + + diff --git a/examples/.svn/text-base/repminM.hs.svn-base b/examples/.svn/text-base/repminM.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/repminM.hs.svn-base @@ -0,0 +1,72 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Repmin where + +import Data.AspectAG +import Data.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 .=. (def $ liftM id (at ch_i)) + .*. emptyRecord ) + +asp_ival () = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (def $ do tree <- at ch_tree + return ( ch_tree .=. tree # smin + .*. emptyRecord ) ) + .*. emptyRecord ) + +asp_sres () = synAspect sres ( nt_Root .*. nt_Tree .*. hNil ) Node (Leaf 0) ( p_Node .*. hNil ) + ( p_Root .=. (def $ do tree <- at ch_tree + return $ tree # sres) + .*. p_Leaf .=. (def $ do lhs <- at lhs + return $ Leaf (lhs # ival)) + .*. emptyRecord ) + + +asp_repmin () = asp_smin () .+. asp_sres () .+. asp_ival () + +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 + + diff --git a/examples/.svn/text-base/test1.hs.svn-base b/examples/.svn/text-base/test1.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test1.hs.svn-base @@ -0,0 +1,106 @@ +{-# OPTIONS -XEmptyDataDecls #-} + +module Test where + +import Data.AspectAG + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + + + +--data types------------------------------------------------------------------- +data Root = Root Tree + deriving Show + +data Tree = Node Tree Tree + | Leaf Int + deriving Show + + +--data types' dependent definitions + +----non terminals +nt_Root = proxy::Proxy Root +nt_Tree = proxy::Proxy Tree + +----productions +data P_Root; p_Root = proxy::Proxy P_Root +data P_Node; p_Node = proxy::Proxy P_Node +data P_Leaf; p_Leaf = proxy::Proxy P_Leaf + +----children labels +data Ch_tree; ch_tree = proxy::Proxy (Ch_tree, Tree) +data Ch_l; ch_l = proxy::Proxy (Ch_l, Tree) +data Ch_r; ch_r = proxy::Proxy (Ch_r, Tree) +data Ch_i; ch_i = proxy::Proxy (Ch_i, Int) + +----catamorphism +sem_Tree asp (Node left right) = knit (asp # p_Node) ( ch_l .=. sem_Tree asp left + .*. ch_r .=. sem_Tree asp right + .*. emptyRecord ) +sem_Tree asp (Leaf i ) = knit (asp # p_Leaf) ( ch_i .=. sem_Lit i + .*. emptyRecord ) +sem_Root asp (Root t ) = knit (asp # p_Root) ( ch_tree .=. sem_Tree asp t + .*. emptyRecord ) + + +--repmin----------------------------------------------------------------------- + +data Att_smin; smin = proxy::Proxy Att_smin +data Att_ival; ival = proxy::Proxy Att_ival +data Att_sres; sres = proxy::Proxy Att_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 ) ) + .*. 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 + + +--average---------------------------------------------------------------------- + +data Att_ssum; ssum = proxy::Proxy Att_ssum +data Att_scnt; scnt = proxy::Proxy Att_scnt + +asp_ssum att f = + synAspect att ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> f chi ) + .*. emptyRecord ) + +asp_avg () = asp_ssum scnt (const 1) .+. asp_ssum ssum (\c -> c # ch_i) .+. asp_sres () .+. asp_ival (\c -> div (c # ssum) (c # scnt)) + +avg tree = sem_Root (asp_avg ()) (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 + +res_avg = avg examplet + diff --git a/examples/.svn/text-base/test1TH.hs.svn-base b/examples/.svn/text-base/test1TH.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test1TH.hs.svn-base @@ -0,0 +1,86 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test where + +import Data.AspectAG +import Data.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 ) ) + .*. 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 + + + + +--average---------------------------------------------------------------------- + +$(attLabels ["ssum","scnt"]) + + +asp_ssum att f = + synAspect att ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> f chi ) + .*. emptyRecord ) + +asp_avg () = asp_ssum scnt (const 1) .+. asp_ssum ssum (\c -> c # ch_i) .+. asp_sres () .+. asp_ival (\c -> div (c # ssum) (c # scnt)) + +avg tree = sem_Root (asp_avg ()) (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 + +res_avg = avg examplet + diff --git a/examples/.svn/text-base/test2.hs.svn-base b/examples/.svn/text-base/test2.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test2.hs.svn-base @@ -0,0 +1,122 @@ +{-# OPTIONS -XEmptyDataDecls #-} + +module Test where + +import Data.AspectAG + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + + + +--data types------------------------------------------------------------------- +data Root = Root Tree + deriving Show + +data Tree = Node Tree Tree + | Bin Tree Int Tree + | Leaf Int + deriving Show + + + +--data types' dependent definitions + +----non terminals +nt_Root = proxy::Proxy Root +nt_Tree = proxy::Proxy Tree + +----productions +data P_Root; p_Root = proxy::Proxy P_Root +data P_Node; p_Node = proxy::Proxy P_Node +data P_Bin; p_Bin = proxy::Proxy P_Bin +data P_Leaf; p_Leaf = proxy::Proxy P_Leaf + +----children labels +data Ch_tree; ch_tree = proxy::Proxy (Ch_tree, Tree) +data Ch_l; ch_l = proxy::Proxy (Ch_l, Tree) +data Ch_r; ch_r = proxy::Proxy (Ch_r, Tree) +data Ch_i; ch_i = proxy::Proxy (Ch_i, Int) +data Ch_lb; ch_lb = proxy::Proxy (Ch_lb, Tree) +data Ch_rb; ch_rb = proxy::Proxy (Ch_rb, Tree) +data Ch_ib; ch_ib = proxy::Proxy (Ch_ib, Int) + +----catamorphism +sem_Tree asp (Node left right) = knit (asp # p_Node) ( ch_l .=. sem_Tree asp left + .*. ch_r .=. sem_Tree asp right + .*. emptyRecord ) +sem_Tree asp (Bin left i right) = knit (asp # p_Bin) ( ch_lb .=. sem_Tree asp left + .*. ch_ib .=. sem_Lit i + .*. ch_rb .=. sem_Tree asp right + .*. emptyRecord ) +sem_Tree asp (Leaf i ) = knit (asp # p_Leaf) ( ch_i .=. sem_Lit i + .*. emptyRecord ) + +sem_Root asp (Root t ) = knit (asp # p_Root) ( ch_tree .=. sem_Tree asp t + .*. emptyRecord ) + + +--repmin----------------------------------------------------------------------- + +data Att_smin; smin = proxy::Proxy Att_smin +data Att_ival; ival = proxy::Proxy Att_ival +data Att_sres; sres = proxy::Proxy Att_sres + + +asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i) + .*. emptyRecord ) + +asp_ival f = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. p_Bin .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. f (chi # ch_tree) + .*. 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)) + .*. p_Bin .=. (\(Fam chi _) -> Bin ((chi # ch_lb) # sres) (chi # ch_ib) ((chi # ch_rb) # sres)) + .*. emptyRecord ) + + +asp_repmin () = asp_smin () .+. asp_sres () .+. asp_ival (\c -> c # smin) + +repmin tree = sem_Root (asp_repmin ()) (Root tree) () # sres + + +--average---------------------------------------------------------------------- + +data Att_ssum; ssum = proxy::Proxy Att_ssum +data Att_scnt; scnt = proxy::Proxy Att_scnt + +asp_ssum () = + synAspect ssum ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i) + .*. emptyRecord ) + +asp_scnt () = + synAspect scnt ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> 1) + .*. emptyRecord ) + +asp_avg () = asp_scnt () .+. asp_ssum () .+. asp_sres () .+. asp_ival (\c -> div (c # ssum) (c # scnt)) + +avg tree = sem_Root (asp_avg ()) (Root tree) () # sres + +----example-------------------------------------------------------------------- + +examplet = (Node (Bin (Node (Leaf 1) (Leaf 4)) + 100 + (Node (Leaf 2) (Leaf 1)) + ) + + (Node (Bin (Leaf 9) 300 (Leaf 8)) + (Leaf 6) + ) + ) + +res_repmin = repmin examplet + +res_avg = avg examplet + diff --git a/examples/.svn/text-base/test2TH.hs.svn-base b/examples/.svn/text-base/test2TH.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test2TH.hs.svn-base @@ -0,0 +1,93 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test where + +import Data.AspectAG +import Data.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} + | Bin {lb::Tree, ib::Int, rb::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 .*. p_Bin .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i) + .*. emptyRecord ) + +asp_ival f = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. p_Bin .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. f (chi # ch_tree) + .*. 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)) + .*. p_Bin .=. (\(Fam chi _) -> Bin ((chi # ch_lb) # sres) (chi # ch_ib) ((chi # ch_rb) # sres)) + .*. emptyRecord ) + + +asp_repmin () = asp_smin () .+. asp_sres () .+. asp_ival (\c -> c # smin) + +repmin tree = sem_Root (asp_repmin ()) (Root tree) () # sres + + + +--average---------------------------------------------------------------------- + +$(attLabels ["ssum","scnt"]) + +asp_ssum () = + synAspect ssum ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i) + .*. emptyRecord ) + +asp_scnt () = + synAspect scnt ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil ) + ( p_Leaf .=. (\(Fam chi _) -> 1) + .*. emptyRecord ) + +asp_avg () = asp_scnt () .+. asp_ssum () .+. asp_sres () .+. asp_ival (\c -> div (c # ssum) (c # scnt)) + +avg tree = sem_Root (asp_avg ()) (Root tree) () # sres + + +----example-------------------------------------------------------------------- + +examplet = (Node (Bin (Node (Leaf 1) (Leaf 4)) + 100 + (Node (Leaf 2) (Leaf 1)) + ) + + (Node (Bin (Leaf 9) 300 (Leaf 8)) + (Leaf 6) + ) + ) + +res_repmin = repmin examplet + +res_avg = avg examplet + diff --git a/examples/.svn/text-base/test3.hs.svn-base b/examples/.svn/text-base/test3.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test3.hs.svn-base @@ -0,0 +1,114 @@ +{-# OPTIONS -XEmptyDataDecls #-} + +module Test where + +import Data.AspectAG + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + + + +--data types------------------------------------------------------------------- +data Root = Root Tree + deriving Show + +data Tree = Node Tree Tree + | Leaf Int + deriving Show + + +--data types' dependent definitions + +----non terminals +nt_Root = proxy::Proxy Root +nt_Tree = proxy::Proxy Tree + +----productions +data P_Root; p_Root = proxy::Proxy P_Root +data P_Node; p_Node = proxy::Proxy P_Node +data P_Leaf; p_Leaf = proxy::Proxy P_Leaf + +----children labels +data Ch_tree; ch_tree = proxy::Proxy (Ch_tree, Tree) +data Ch_l; ch_l = proxy::Proxy (Ch_l, Tree) +data Ch_r; ch_r = proxy::Proxy (Ch_r, Tree) +data Ch_i; ch_i = proxy::Proxy (Ch_i, Int) + +----catamorphism +sem_Tree asp (Node left right) = knit (asp # p_Node) ( ch_l .=. sem_Tree asp left + .*. ch_r .=. sem_Tree asp right + .*. emptyRecord ) +sem_Tree asp (Leaf i ) = knit (asp # p_Leaf) ( ch_i .=. sem_Lit i + .*. emptyRecord ) +sem_Root asp (Root t ) = knit (asp # p_Root) ( ch_tree .=. sem_Tree asp t + .*. emptyRecord ) + + +--repmin----------------------------------------------------------------------- + +data Att_smin; smin = proxy::Proxy Att_smin +data Att_ival; ival = proxy::Proxy Att_ival +data Att_sres; sres = proxy::Proxy Att_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 a = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. (chi # ch_tree) # a + .*. emptyRecord ) ) + .*. emptyRecord ) + +asp_sres a = 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 # a)) + .*. emptyRecord ) + + +asp_repmin a = asp_smin () .+. asp_sres a .+. asp_ival smin + +repmin tree = sem_Root (asp_repmin ival) (Root tree) () # sres + + +--chained attribute------------------------------------------------------------ + +data Att_ccnt; ccnt = proxy::Proxy Att_ccnt + + +asp_ccnt () = chnAspect ccnt (nt_Root .*. nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam _ _) -> ( ch_tree .=. (0::Int) + .*. emptyRecord ) ) + .*. emptyRecord ) + ( p_Leaf .=. (\(Fam chi par) -> + if chi # ch_i == (par # ival) + then (par # ccnt) +1 + else par # ccnt + ) + .*. emptyRecord ) + + + +asp_cnt () = asp_ccnt () .+. asp_repmin ccnt + +cnt tree = sem_Root (asp_cnt ()) (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 + +res_cnt = cnt examplet + diff --git a/examples/.svn/text-base/test3TH.hs.svn-base b/examples/.svn/text-base/test3TH.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test3TH.hs.svn-base @@ -0,0 +1,91 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test where + +import Data.AspectAG +import Data.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 a = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. (chi # ch_tree) # a + .*. emptyRecord ) ) + .*. emptyRecord ) + +asp_sres a = 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 # a)) + .*. emptyRecord ) + + +asp_repmin a = asp_smin () .+. asp_sres a .+. asp_ival smin + +repmin tree = sem_Root (asp_repmin ival) (Root tree) () # sres + + +--chained attribute------------------------------------------------------------ + +$(attLabel "ccnt") + + +asp_ccnt () = chnAspect ccnt (nt_Root .*. nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam _ _) -> ( ch_tree .=. (0::Int) + .*. emptyRecord ) ) + .*. emptyRecord ) + ( p_Leaf .=. (\(Fam chi par) -> + if chi # ch_i == (par # ival) + then (par # ccnt) +1 + else par # ccnt + ) + .*. emptyRecord ) + + + +asp_cnt () = asp_ccnt () .+. asp_repmin ccnt + +cnt tree = sem_Root (asp_cnt ()) (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 + +res_cnt = cnt examplet + diff --git a/examples/.svn/text-base/test4.hs.svn-base b/examples/.svn/text-base/test4.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test4.hs.svn-base @@ -0,0 +1,93 @@ +{-# OPTIONS -XEmptyDataDecls #-} + +module Test where + +import Data.AspectAG + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + + + +--data types------------------------------------------------------------------- +data Root = Root Tree + deriving Show + +data Tree = Node Tree Tree + | Leaf Int + deriving Show + + +--data types' dependent definitions + +----non terminals +nt_Root = proxy::Proxy Root +nt_Tree = proxy::Proxy Tree + +----productions +data P_Root; p_Root = proxy::Proxy P_Root +data P_Node; p_Node = proxy::Proxy P_Node +data P_Leaf; p_Leaf = proxy::Proxy P_Leaf + +----children labels +data Ch_tree; ch_tree = proxy::Proxy (Ch_tree, Tree) +data Ch_l; ch_l = proxy::Proxy (Ch_l, Tree) +data Ch_r; ch_r = proxy::Proxy (Ch_r, Tree) +data Ch_i; ch_i = proxy::Proxy (Ch_i, Int) + +----catamorphism +sem_Tree asp (Node left right) = knit (asp # p_Node) ( ch_l .=. sem_Tree asp left + .*. ch_r .=. sem_Tree asp right + .*. emptyRecord ) +sem_Tree asp (Leaf i ) = knit (asp # p_Leaf) ( ch_i .=. sem_Lit i + .*. emptyRecord ) +sem_Root asp (Root t ) = knit (asp # p_Root) ( ch_tree .=. sem_Tree asp t + .*. emptyRecord ) + + +--repmin----------------------------------------------------------------------- + +data Att_smin; smin = proxy::Proxy Att_smin +data Att_ival; ival = proxy::Proxy Att_ival +data Att_sres; sres = proxy::Proxy Att_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 + + diff --git a/examples/.svn/text-base/test4TH.hs.svn-base b/examples/.svn/text-base/test4TH.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test4TH.hs.svn-base @@ -0,0 +1,70 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test where + +import Data.AspectAG +import Data.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 + + diff --git a/examples/.svn/text-base/test5.hs.svn-base b/examples/.svn/text-base/test5.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test5.hs.svn-base @@ -0,0 +1,116 @@ +{-# OPTIONS -XEmptyDataDecls #-} + +module Test where + +import Data.AspectAG + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + + + +--data types------------------------------------------------------------------- +data Root = Root Tree + deriving Show + +data Tree = Node Tree Tree + | Leaf Int + deriving Show + + +--data types' dependent definitions + +----non terminals +nt_Root = proxy::Proxy Root +nt_Tree = proxy::Proxy Tree + +----productions +data P_Root; p_Root = proxy::Proxy P_Root +data P_Node; p_Node = proxy::Proxy P_Node +data P_Leaf; p_Leaf = proxy::Proxy P_Leaf + +----children labels +data Ch_tree; ch_tree = proxy::Proxy (Ch_tree, Tree) +data Ch_l; ch_l = proxy::Proxy (Ch_l, Tree) +data Ch_r; ch_r = proxy::Proxy (Ch_r, Tree) +data Ch_i; ch_i = proxy::Proxy (Ch_i, Int) + +----catamorphism +sem_Tree asp (Node left right) = knit (asp # p_Node) ( ch_l .=. sem_Tree asp left + .*. ch_r .=. sem_Tree asp right + .*. emptyRecord ) +sem_Tree asp (Leaf i ) = knit (asp # p_Leaf) ( ch_i .=. sem_Lit i + .*. emptyRecord ) +sem_Root asp (Root t ) = knit (asp # p_Root) ( ch_tree .=. sem_Tree asp t + .*. emptyRecord ) + + +--repmin----------------------------------------------------------------------- + +data Att_smin; smin = proxy::Proxy Att_smin +data Att_ival; ival = proxy::Proxy Att_ival +data Att_sres; sres = proxy::Proxy Att_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 a = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. (chi # ch_tree) # a + .*. emptyRecord ) ) + .*. emptyRecord ) + +asp_sres a = 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 # a)) + .*. emptyRecord ) + + +asp_repmin a = asp_smin () .+. asp_sres a .+. asp_ival smin + +repmin tree = sem_Root (asp_repmin ival) (Root tree) () # sres + + +--chained attribute------------------------------------------------------------ + +data Att_ccnt; ccnt = proxy::Proxy Att_ccnt + + +asp_ccnt () = chnAspect ccnt (nt_Root .*. nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam _ _) -> ( ch_tree .=. (0::Int) + .*. emptyRecord ) ) + .*. p_Node .=. (\(Fam _ par) -> ( ch_l .=. (par # ccnt) + 10 -- diference with scn (doesn't use chain rule for ch_l) + .*. emptyRecord) ) + .*. emptyRecord ) + ( p_Leaf .=. (\(Fam chi par) -> + if chi # ch_i == (par # ival) + then (par # ccnt) +1 + else par # ccnt + ) + .*. emptyRecord ) + + + +asp_cnt () = asp_ccnt () .+. asp_repmin ccnt + +cnt tree = sem_Root (asp_cnt ()) (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 + +res_cnt = cnt examplet + diff --git a/examples/.svn/text-base/test5TH.hs.svn-base b/examples/.svn/text-base/test5TH.hs.svn-base new file mode 100644 --- /dev/null +++ b/examples/.svn/text-base/test5TH.hs.svn-base @@ -0,0 +1,93 @@ +{-# OPTIONS -XEmptyDataDecls #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test where + +import Data.AspectAG +import Data.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 a = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. (chi # ch_tree) # a + .*. emptyRecord ) ) + .*. emptyRecord ) + +asp_sres a = 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 # a)) + .*. emptyRecord ) + + +asp_repmin a = asp_smin () .+. asp_sres a .+. asp_ival smin + +repmin tree = sem_Root (asp_repmin ival) (Root tree) () # sres + + +--chained attribute------------------------------------------------------------ + +$(attLabel "ccnt") + + +asp_ccnt () = chnAspect ccnt (nt_Root .*. nt_Tree .*. hNil ) ( p_Node .*. hNil ) + ( p_Root .=. (\(Fam _ _) -> ( ch_tree .=. (0::Int) + .*. emptyRecord ) ) + .*. p_Node .=. (\(Fam _ par) -> ( ch_l .=. (par # ccnt) + 10 -- diference with scn (doesn't use chain rule for ch_l) + .*. emptyRecord) ) + .*. emptyRecord ) + ( p_Leaf .=. (\(Fam chi par) -> + if chi # ch_i == (par # ival) + then (par # ccnt) +1 + else par # ccnt + ) + .*. emptyRecord ) + + + +asp_cnt () = asp_ccnt () .+. asp_repmin ccnt + +cnt tree = sem_Root (asp_cnt ()) (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 + +res_cnt = cnt examplet + diff --git a/examples/repmin.hs b/examples/repmin.hs --- a/examples/repmin.hs +++ b/examples/repmin.hs @@ -35,7 +35,7 @@ .*. emptyRecord ) asp_ival () = inhAspect ival ( nt_Tree .*. hNil ) ( p_Node .*. hNil ) - ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. (chi # ch_tree) # smin + ( p_Root .=. (\(Fam chi _) -> ( ch_tree .=. ((chi # ch_tree) # smin) .*. emptyRecord ) ) .*. emptyRecord ) @@ -45,7 +45,7 @@ .*. emptyRecord ) -asp_repmin () = asp_smin () .+. asp_sres () .+. asp_ival () +asp_repmin () = asp_sres () .+. asp_ival () .+. asp_smin () repmin tree = sem_Root (asp_repmin ()) (Root tree) () # sres @@ -63,6 +63,20 @@ (Leaf 6) ) ) + +slidest = Node { l = Node { l = Node { l = Leaf { i = 5} + , r = Leaf { i = 4} + } + , r = Node { l = Leaf { i = 2} + , r = Leaf { i = 3} + } + } + , r = Node { l = Leaf { i = 9 } + , r = Node { l = Leaf { i = 7} + , r = Leaf { i = 6} + } + } + } res_repmin = repmin examplet diff --git a/src/Data/AspectAG.hs b/src/Data/AspectAG.hs --- a/src/Data/AspectAG.hs +++ b/src/Data/AspectAG.hs @@ -654,9 +654,9 @@ , HUpdateAtHNat n (LVPair l v) r r') => HUpdateAtLabel l v (Record r) (Record r') where - hUpdateAtLabel l v (Record r) = Record r' + hUpdateAtLabel l v rec@(Record r) = Record r' where - n = hFind l (recordLabels r) + n = hFind l (recordLabels rec) r' = hUpdateAtHNat n (newLVPair l v) r