AspectAG 0.1.2 → 0.1.3
raw patch · 21 files changed
+135/−1607 lines, 21 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.AspectAG.Derive: typeList :: String -> String -> Q [Dec]
Files
- AspectAG.cabal +1/−1
- examples/.svn/all-wcprops +0/−89
- examples/.svn/entries +0/−196
- examples/.svn/format +0/−1
- examples/.svn/text-base/calc.hs.svn-base +0/−80
- examples/.svn/text-base/calcM.hs.svn-base +0/−96
- examples/.svn/text-base/repmin.hs.svn-base +0/−69
- examples/.svn/text-base/repminM.hs.svn-base +0/−72
- examples/.svn/text-base/test1.hs.svn-base +0/−106
- examples/.svn/text-base/test1TH.hs.svn-base +0/−86
- examples/.svn/text-base/test2.hs.svn-base +0/−122
- examples/.svn/text-base/test2TH.hs.svn-base +0/−93
- examples/.svn/text-base/test3.hs.svn-base +0/−114
- examples/.svn/text-base/test3TH.hs.svn-base +0/−91
- examples/.svn/text-base/test4.hs.svn-base +0/−93
- examples/.svn/text-base/test4TH.hs.svn-base +0/−70
- examples/.svn/text-base/test5.hs.svn-base +0/−116
- examples/.svn/text-base/test5TH.hs.svn-base +0/−93
- examples/testEmptyNode.hs +42/−0
- examples/testList.hs +45/−0
- src/Data/AspectAG/Derive.hs +47/−19
AspectAG.cabal view
@@ -1,5 +1,5 @@ name: AspectAG -version: 0.1.2+version: 0.1.3 license: LGPL license-file: COPYRIGHT maintainer: Marcos Viera <mviera@fing.edu.uy>
− examples/.svn/all-wcprops
@@ -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
− examples/.svn/entries
@@ -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-
− examples/.svn/format
@@ -1,1 +0,0 @@-8
− examples/.svn/text-base/calc.hs.svn-base
@@ -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-
− examples/.svn/text-base/calcM.hs.svn-base
@@ -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-
− examples/.svn/text-base/repmin.hs.svn-base
@@ -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--
− examples/.svn/text-base/repminM.hs.svn-base
@@ -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--
− examples/.svn/text-base/test1.hs.svn-base
@@ -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-
− examples/.svn/text-base/test1TH.hs.svn-base
@@ -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-
− examples/.svn/text-base/test2.hs.svn-base
@@ -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-
− examples/.svn/text-base/test2TH.hs.svn-base
@@ -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-
− examples/.svn/text-base/test3.hs.svn-base
@@ -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-
− examples/.svn/text-base/test3TH.hs.svn-base
@@ -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-
− examples/.svn/text-base/test4.hs.svn-base
@@ -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--
− examples/.svn/text-base/test4TH.hs.svn-base
@@ -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--
− examples/.svn/text-base/test5.hs.svn-base
@@ -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-
− examples/.svn/text-base/test5TH.hs.svn-base
@@ -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-
+ examples/testEmptyNode.hs view
@@ -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 +
+ examples/testList.hs view
@@ -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 +
src/Data/AspectAG/Derive.hs view
@@ -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++++