diff --git a/AspectAG.cabal b/AspectAG.cabal --- a/AspectAG.cabal +++ b/AspectAG.cabal @@ -1,5 +1,5 @@ name: AspectAG -version: 0.1.2 +version: 0.1.3 license: LGPL license-file: COPYRIGHT maintainer: Marcos Viera diff --git a/examples/.svn/all-wcprops b/examples/.svn/all-wcprops deleted file mode 100644 --- a/examples/.svn/all-wcprops +++ /dev/null @@ -1,89 +0,0 @@ -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 deleted file mode 100644 --- a/examples/.svn/entries +++ /dev/null @@ -1,196 +0,0 @@ -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 deleted file mode 100644 --- a/examples/.svn/format +++ /dev/null @@ -1,1 +0,0 @@ -8 diff --git a/examples/.svn/text-base/calc.hs.svn-base b/examples/.svn/text-base/calc.hs.svn-base deleted file mode 100644 --- a/examples/.svn/text-base/calc.hs.svn-base +++ /dev/null @@ -1,80 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/calcM.hs.svn-base +++ /dev/null @@ -1,96 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/repmin.hs.svn-base +++ /dev/null @@ -1,69 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/repminM.hs.svn-base +++ /dev/null @@ -1,72 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test1.hs.svn-base +++ /dev/null @@ -1,106 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test1TH.hs.svn-base +++ /dev/null @@ -1,86 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test2.hs.svn-base +++ /dev/null @@ -1,122 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test2TH.hs.svn-base +++ /dev/null @@ -1,93 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test3.hs.svn-base +++ /dev/null @@ -1,114 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test3TH.hs.svn-base +++ /dev/null @@ -1,91 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test4.hs.svn-base +++ /dev/null @@ -1,93 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test4TH.hs.svn-base +++ /dev/null @@ -1,70 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test5.hs.svn-base +++ /dev/null @@ -1,116 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/examples/.svn/text-base/test5TH.hs.svn-base +++ /dev/null @@ -1,93 +0,0 @@ -{-# 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/testEmptyNode.hs b/examples/testEmptyNode.hs new file mode 100644 --- /dev/null +++ b/examples/testEmptyNode.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} + +module Test where + + +import Data.AspectAG +import Data.AspectAG.Derive + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + + +data EList = ECons {e :: Expression, es :: EList} | ENil + + +data Expression + = Application { eFn :: Expression, eArgs :: EList } + | Atom { eAtom :: String } + | Lambda { eFormalArgs :: [String], eBody :: Expression } + | Constant { eConst :: Int } + + +$(deriveAG ''Expression) + +$(attLabel "cantArgs") + +allNT = nt_Expression .*. nt_EList .*. hNil + +-- counts the total number of 'eArgs' in an expression +asp_cantArgs () = synAspect cantArgs allNT + ((+)::Int->Int->Int) (0::Int) ( p_Application .*. p_Atom .*. p_Lambda .*. p_Constant .*. p_ENil .*. hNil ) -- use rule + ( p_ECons .=. (def $ do e <- at ch_e + es <- at ch_es + return $ (e # cantArgs) + 1 + (es # cantArgs) ) -- add 1 for each element of the list + .*. emptyRecord ) + + +ex = Application (Lambda ["x","y"] (Atom "x")) (ECons (Constant 2) $ ECons (Constant 5) ENil) + +main = sem_Expression (asp_cantArgs ()) ex emptyRecord # cantArgs + diff --git a/examples/testList.hs b/examples/testList.hs new file mode 100644 --- /dev/null +++ b/examples/testList.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} + +module Test where +import qualified Data.Set as S + + +import Data.AspectAG +import Data.AspectAG.Derive + +import Data.HList.Label4 +import Data.HList.TypeEqGeneric1 +import Data.HList.TypeCastGeneric1 + +import Language.Haskell.TH + +$(typeList "EList" "Expression") + +data Expression + = Application { eFn :: Expression, eArgs :: EList } + | Atom { eAtom :: String } + | Lambda { eFormalArgs :: [String], eBody :: Expression } + | Constant { eConst :: Int } + + +$(deriveAG ''Expression) + +$(attLabel "cantArgs") + +allNT = nt_Expression .*. nt_EList .*. hNil + +-- counts the total number of 'eArgs' in an expression +asp_cantArgs () = synAspect cantArgs allNT + ((+)::Int->Int->Int) (0::Int) ( p_Application .*. p_Atom .*. p_Lambda .*. p_Constant .*. p_NilEList .*. hNil ) -- use rule + ( p_ConsEList .=. (def $ do e <- at ch_hdEList + es <- at ch_tlEList + return $ (e # cantArgs) + 1 + (es # cantArgs) ) -- add 1 for each element of the list + .*. emptyRecord ) + + + +ex = Application (Lambda ["x","y"] (Atom "x")) (ConsEList (Constant 2) $ ConsEList (Constant 5) NilEList) + + +main = sem_Expression (asp_cantArgs ()) ex emptyRecord # cantArgs + diff --git a/src/Data/AspectAG/Derive.hs b/src/Data/AspectAG/Derive.hs --- a/src/Data/AspectAG/Derive.hs +++ b/src/Data/AspectAG/Derive.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS -XEmptyDataDecls #-} -module Data.AspectAG.Derive (deriveAG, attLabel, attLabels) where +module Data.AspectAG.Derive (deriveAG, attLabel, attLabels, typeList) where import Language.Haskell.TH @@ -9,8 +9,6 @@ import Data.List (isPrefixOf) import qualified Data.Set as S ---import Data.HList - import Data.AspectAG data UserType = UserD Name [Name] [Con] @@ -69,7 +67,7 @@ derive n (stn,decl) = do info <- reify n - if (S.member n stn || primitive info) + if (S.member n stn || not (isNT info)) then return (stn,decl) else let stn' = S.insert n stn in do @@ -83,7 +81,7 @@ deriveCons ((stn,decl),fc) c = do let (cht,chn,cn) = getCtx c - (stn',decl') <- foldM (\td t -> derive (typeName t) td) (stn,decl) cht + (stn',decl') <- foldM (\td t -> deriveList (typeNames t) td) (stn,decl) cht conargs <- newNames cht body <- [| knit ($(aspV) # $(att cn)) $(childs cht chn conargs) |] let semF = Clause (pat cn conargs) (NormalB body) [] @@ -102,14 +100,17 @@ att cn = varE $ prdName cn ch cn = varE $ chName cn childs [] _ _ = [| emptyRecord |] - childs (t:ts) (n:ns) (p:ps) = [| $(ch n) .=. $(chFun (typeName t) p) .*. $(childs ts ns ps) |] + childs (t:ts) (n:ns) (p:ps) = case (typeName1 t) of + Just tn -> [| $(ch n) .=. $(chFun tn p) .*. $(childs ts ns ps) |] + Nothing -> [| $(childs ts ns ps) |] childs _ _ _ = error "Impossible case!!" + deriveList ns td = foldM (flip $ derive) td ns chFun tn n = do i <- reify (tn) - if primitive i - then [| ( \(Record HNil) -> $(varE n) ) |] - else [| $(varE (semName tn)) $(aspV) $(varE n) |] + if isNT i + then [| $(varE (semName tn)) $(aspV) $(varE n) |] + else [| ( \(Record HNil) -> $(varE n) ) |] @@ -127,7 +128,8 @@ getCtx :: Con -> ([Type],[Name], Name) getCtx (RecC name args) = (map thd args, map fst' args, name) -getCtx (NormalC name _) = error $ "Constructor " ++ (show name) ++ " is not a record." +getCtx (NormalC name []) = ([],[],name) +getCtx (NormalC name _) = error $ "Constructor " ++ (show name) ++ " is not a record." getCtx (InfixC _ name _) = error $ "Constructor " ++ (show name) ++ " is not a record." getCtx _ = error $ "Cannot derive a 'forall' constructor." @@ -139,18 +141,44 @@ -primitive :: Info -> Bool -primitive (PrimTyConI _ _ _) = True -primitive (TyConI (DataD _ n _ _ _)) = isPrefixOf "GHC" (show n) -primitive (TyConI (TySynD _ _ _)) = True -- type synonyms to escape -primitive _ = False +isNT :: Info -> Bool +isNT (PrimTyConI _ _ _) = False +isNT (TyConI (DataD _ n _ _ _)) = not $ isPrefixOf "GHC" (show n) -- GHC types can't be non-terminals +isNT (TyConI (TySynD _ _ _)) = False -- type synonyms to escape +isNT _ = True -typeName :: Type -> Name -typeName t = case t of - VarT varname -> varname - ConT conname -> conname +typeNames :: Type -> [ Name ] +typeNames t = case t of + VarT _ -> [ ] + ConT conname -> [ conname ] + AppT t1 t2 -> typeNames t1 ++ typeNames t2 _ -> error $ "Not valid type " ++ (show t) +typeName1 :: Type -> Maybe Name +typeName1 t = case t of + VarT _ -> Nothing + ConT conname -> Just conname + AppT t1 _ -> typeName1 t1 + _ -> error $ "Not valid type " ++ (show t) + + +typeList :: String -> String -> Q [Dec] +typeList nData nArg = + do + let ddef = DataD [] dataName [] [ RecC consName [(hdName, NotStrict, ConT argName), (tlName ,NotStrict, ConT dataName) ] + , NormalC nilName []] [] + return [ ddef ] + where + dataName = mkName nData + argName = mkName nArg + consName = mkName $ "Cons" ++ nData + nilName = mkName $ "Nil" ++ nData + hdName = mkName $ "hd" ++ nData + tlName = mkName $ "tl" ++ nData + + + +