diff --git a/AspectAG.cabal b/AspectAG.cabal --- a/AspectAG.cabal +++ b/AspectAG.cabal @@ -1,5 +1,5 @@ name: AspectAG -version: 0.3.1 +version: 0.3.2 cabal-version: >= 1.2.3 license: LGPL license-file: COPYRIGHT diff --git a/examples/Main.hs b/examples/Main.hs --- a/examples/Main.hs +++ b/examples/Main.hs @@ -11,7 +11,7 @@ -- | -- ----------------------------------------------------------------------------- - +{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Main where diff --git a/examples/calc.hs b/examples/calc.hs --- a/examples/calc.hs +++ b/examples/calc.hs @@ -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 ) diff --git a/examples/calcM.hs b/examples/calcM.hs --- a/examples/calcM.hs +++ b/examples/calcM.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -XEmptyDataDecls #-} -{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -fcontext-stack=100 #-} +{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Calc where diff --git a/examples/repmin.hs b/examples/repmin.hs --- a/examples/repmin.hs +++ b/examples/repmin.hs @@ -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 ) diff --git a/examples/repminM.hs b/examples/repminM.hs --- a/examples/repminM.hs +++ b/examples/repminM.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -XEmptyDataDecls #-} -{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -fcontext-stack=100 #-} +{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Repmin where diff --git a/examples/test1.hs b/examples/test1.hs --- a/examples/test1.hs +++ b/examples/test1.hs @@ -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)) diff --git a/examples/test2.hs b/examples/test2.hs --- a/examples/test2.hs +++ b/examples/test2.hs @@ -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)) diff --git a/examples/test2TH.hs b/examples/test2TH.hs --- a/examples/test2TH.hs +++ b/examples/test2TH.hs @@ -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)) diff --git a/examples/test3.hs b/examples/test3.hs --- a/examples/test3.hs +++ b/examples/test3.hs @@ -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 diff --git a/examples/test3TH.hs b/examples/test3TH.hs --- a/examples/test3TH.hs +++ b/examples/test3TH.hs @@ -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 diff --git a/examples/test4.hs b/examples/test4.hs --- a/examples/test4.hs +++ b/examples/test4.hs @@ -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 ) diff --git a/examples/test4TH.hs b/examples/test4TH.hs --- a/examples/test4TH.hs +++ b/examples/test4TH.hs @@ -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 ) diff --git a/examples/test5.hs b/examples/test5.hs --- a/examples/test5.hs +++ b/examples/test5.hs @@ -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 diff --git a/examples/test5TH.hs b/examples/test5TH.hs --- a/examples/test5TH.hs +++ b/examples/test5TH.hs @@ -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 diff --git a/examples/testEmptyNode.hs b/examples/testEmptyNode.hs --- a/examples/testEmptyNode.hs +++ b/examples/testEmptyNode.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where diff --git a/examples/testList.hs b/examples/testList.hs --- a/examples/testList.hs +++ b/examples/testList.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -fcontext-stack=100 #-} {-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} module Test where diff --git a/src/Language/Grammars/AspectAG.hs b/src/Language/Grammars/AspectAG.hs --- a/src/Language/Grammars/AspectAG.hs +++ b/src/Language/Grammars/AspectAG.hs @@ -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 diff --git a/src/Language/Grammars/AspectAG/Derive.hs b/src/Language/Grammars/AspectAG/Derive.hs --- a/src/Language/Grammars/AspectAG/Derive.hs +++ b/src/Language/Grammars/AspectAG/Derive.hs @@ -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)