AspectAG 0.3.1 → 0.3.2
raw patch · 19 files changed
+126/−115 lines, 19 files
Files
- AspectAG.cabal +1/−1
- examples/Main.hs +1/−1
- examples/calc.hs +15/−15
- examples/calcM.hs +2/−2
- examples/repmin.hs +7/−7
- examples/repminM.hs +2/−2
- examples/test1.hs +8/−7
- examples/test2.hs +10/−9
- examples/test2TH.hs +10/−10
- examples/test3.hs +10/−9
- examples/test3TH.hs +10/−10
- examples/test4.hs +9/−8
- examples/test4TH.hs +9/−9
- examples/test5.hs +12/−11
- examples/test5TH.hs +12/−12
- examples/testEmptyNode.hs +1/−0
- examples/testList.hs +1/−0
- src/Language/Grammars/AspectAG.hs +4/−2
- src/Language/Grammars/AspectAG/Derive.hs +2/−0
AspectAG.cabal view
@@ -1,5 +1,5 @@ name: AspectAG -version: 0.3.1+version: 0.3.2 cabal-version: >= 1.2.3 license: LGPL license-file: COPYRIGHT
examples/Main.hs view
@@ -11,7 +11,7 @@ -- | -- ------------------------------------------------------------------------------+{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Main where
examples/calc.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Calc where @@ -35,27 +35,27 @@ $(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) >|< "]") + ( 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))+ ( 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) + ( 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 ) @@ -64,7 +64,7 @@ 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 ) + ( p_Add .=. (\(Fam _ _ chi _) -> ((chi # ch_e2) # ccount) + 1 ) .*. emptyRecord )
examples/calcM.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Calc where
examples/repmin.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Repmin where @@ -31,17 +31,17 @@ $(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)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # ival)) .*. emptyRecord )
examples/repminM.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Repmin where
examples/test1.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE EmptyDataDecls #-} module Test where @@ -54,17 +55,17 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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_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_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # ival)) .*. emptyRecord ) @@ -80,7 +81,7 @@ asp_ssum att f = synAspect att ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> f chi )+ ( 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))
examples/test2.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE EmptyDataDecls #-} module Test where @@ -65,18 +66,18 @@ 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)+ ( 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 ) )+ ( 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))+ ( 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 ) @@ -92,12 +93,12 @@ asp_ssum () = synAspect ssum ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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)+ ( p_Leaf .=. (\(Fam _ _ chi _) -> 1) .*. emptyRecord ) asp_avg () = asp_scnt () .+. asp_ssum () .+. asp_sres () .+. asp_ival (\c -> div (c # ssum) (c # scnt))
examples/test2TH.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where @@ -35,18 +35,18 @@ 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)+ ( 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 ) )+ ( 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))+ ( 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 ) @@ -62,12 +62,12 @@ asp_ssum () = synAspect ssum ( nt_Tree .*. hNil ) ((+)::Int->Int->Int) (0::Int) ( p_Node .*. p_Bin .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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)+ ( p_Leaf .=. (\(Fam _ _ chi _) -> 1) .*. emptyRecord ) asp_avg () = asp_scnt () .+. asp_ssum () .+. asp_sres () .+. asp_ival (\c -> div (c # ssum) (c # scnt))
examples/test3.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE EmptyDataDecls #-} module Test where @@ -54,17 +55,17 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # a)) .*. emptyRecord ) @@ -79,10 +80,10 @@ asp_ccnt () = chnAspect ccnt (nt_Root .*. nt_Tree .*. hNil ) ( p_Node .*. hNil )- ( p_Root .=. (\(Fam _ _) -> ( ch_tree .=. (0::Int)- .*. emptyRecord ) ) + ( p_Root .=. (\(Fam _ _ _ _) -> ( ch_tree .=. (0::Int)+ .*. emptyRecord ) ) .*. emptyRecord )- ( p_Leaf .=. (\(Fam chi par) -> + ( p_Leaf .=. (\(Fam _ _ chi par) -> if chi # ch_i == (par # ival) then (par # ccnt) +1 else par # ccnt
examples/test3TH.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where @@ -31,17 +31,17 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # a)) .*. emptyRecord ) @@ -56,10 +56,10 @@ asp_ccnt () = chnAspect ccnt (nt_Root .*. nt_Tree .*. hNil ) ( p_Node .*. hNil )- ( p_Root .=. (\(Fam _ _) -> ( ch_tree .=. (0::Int)- .*. emptyRecord ) ) + ( p_Root .=. (\(Fam _ _ _ _) -> ( ch_tree .=. (0::Int)+ .*. emptyRecord ) ) .*. emptyRecord )- ( p_Leaf .=. (\(Fam chi par) -> + ( p_Leaf .=. (\(Fam _ _ chi par) -> if chi # ch_i == (par # ival) then (par # ccnt) +1 else par # ccnt
examples/test4.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE EmptyDataDecls #-} module Test where @@ -54,19 +55,19 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # ival)) .*. emptyRecord )
examples/test4TH.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where @@ -31,19 +31,19 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # ival)) .*. emptyRecord )
examples/test5.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE EmptyDataDecls #-} module Test where @@ -54,17 +55,17 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # a)) .*. emptyRecord ) @@ -79,12 +80,12 @@ 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) ) + ( 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) -> + ( p_Leaf .=. (\(Fam _ _ chi par) -> if chi # ch_i == (par # ival) then (par # ccnt) +1 else par # ccnt
examples/test5TH.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS -XEmptyDataDecls #-}-{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS -fcontext-stack=100 #-}+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where @@ -31,17 +31,17 @@ asp_smin () = synAspect smin ( nt_Tree .*. hNil ) (min::Int->Int->Int) (0::Int) ( p_Node .*. hNil )- ( p_Leaf .=. (\(Fam chi _) -> chi # ch_i)+ ( 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 ) )+ ( 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))+ ( p_Root .=. (\(Fam _ _ chi _) -> (chi # ch_tree) # sres)+ .*. p_Leaf .=. (\(Fam _ _ _ par) -> Leaf (par # a)) .*. emptyRecord ) @@ -56,12 +56,12 @@ 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) ) + ( 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) -> + ( p_Leaf .=. (\(Fam _ _ chi par) -> if chi # ch_i == (par # ival) then (par # ccnt) +1 else par # ccnt
examples/testEmptyNode.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where
examples/testList.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where
src/Language/Grammars/AspectAG.hs view
@@ -725,7 +725,7 @@ => Chain att nts val sc l ho ic sp ic' sp' where defchn att nts val sc inp@(Fam _ _ _ sp) = defchn' msp att nts val sc inp - where msp = hasLabel att sp + where msp = hasLabel att sp @@ -958,7 +958,9 @@ data FnChn att nt = FnChn att nt -instance ( Chain att nts val sc l ho ic sp ic' sp' +instance ( Chain att nts val sc l ho ic sp ic' sp' + , HasLabel att sp msp + , Chain' msp att nts val sc l ho ic sp ic' sp' , HasField att ip val , TypeCast (Rule lf hof sc ip l ho ic sp l ho ic' sp') r) => Poly (FnChn att nts) r where
src/Language/Grammars/AspectAG/Derive.hs view
@@ -177,6 +177,7 @@ VarT _ -> [ ] ConT conname -> [ conname ] AppT t1 t2 -> typeNames t1 ++ typeNames t2+ ListT -> [ ] _ -> error $ "Not valid type " ++ (show t) @@ -185,6 +186,7 @@ VarT _ -> Nothing ConT conname -> Just conname AppT t1 _ -> typeName1 t1+ ListT -> Nothing _ -> error $ "Not valid type " ++ (show t)