AspectAG 0.3.4.1 → 0.3.5

raw patch · 3 files changed

+85/−17 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• .AspectAG.cabal.swp binary
• AspectAG.cabal +1/−1
• src/Language/Grammars/AspectAG.hs +84/−16

binary file changed (12288 → absent bytes)

@@ -1,5 +1,5 @@ name:               AspectAG -version:            0.3.4.1+version:            0.3.5 cabal-version:      >= 1.2.3   license:            LGPL license-file:       COPYRIGHT

@@ -26,18 +26,22 @@               instdef, locdef,
               inhdef, syndef, 
               inhmod, synmod,
+              {-inhupd,-} synupd,
 
               -- ** Monadic
 
               At(..), lhs, loc, def,
               instdefM, locdefM,
-              inhdefM, syndefM,
+              inhdefM, syndefM, inh, syn,
               inhmodM, synmodM,
+              {-inhupdM,-} synupdM,
 
               -- ** Rules Composition
               ext, adapt, rename, mapChildren, fixCst, graft,
-              agMacro, (~~>), (==>), (-->), (<.>), 
+              agMacro, (~~>), (==>), (-->), (<.>), ignore, noChild,
 
+              withChild, withChildAtt,
+
               -- * Aspects
               Prd, (.+.),
 
@@ -51,7 +55,7 @@               -- * Defining Aspects
               inhAspect, synAspect, chnAspect,
               attAspect, defAspect, 
-
+              Defs(..),
               -- * Others
               ListNT(..),
 
@@ -115,6 +119,7 @@         =>  att -> val -> (Fam l ho ic sp -> Fam l ho ic sp')
 syndef  att val (Fam l ho ic sp) = Fam l ho ic (att .=. val .*. sp)
 
+
 -- | The function 'synmod' modifies the definition of a synthesized attribute.
 --   It takes a label 'att' representing the name of the attribute, 
 --   a value 'val' to be assigned to this attribute, and it builds a function which 
@@ -123,6 +128,12 @@         =>  att -> val -> Fam l ho ic sp -> Fam l ho ic sp' 
 synmod att v (Fam l ho ic sp) = Fam l ho ic (hUpdateAtLabel att v sp) 
 
+
+synupd att f (Fam l ho ic sp) =  r'
+                               where  v  =  f (sp # att)
+                                      r' =  Fam l ho ic (hUpdateAtLabel att v sp) 
+
+
 -- | The function 'inhdef' introduces a new inherited attribute for 
 --   a collection of non-terminals.
 --   It takes the following parameters:
@@ -610,27 +621,52 @@ infixr 4 -->
 
 -- | Child mapping definition, it reads /binds to/.
-(-->) ::                (HExtend (LVPair e v1) l1 t10,
-                         HExtend (LVPair e v) l t11,
-                         HasField (Proxy lch2) r1 v1,
-                         HasField e t4 v2,
-                         HasField (Proxy lch2) r v,
-                         HRLabelSet (HCons (LVPair (Proxy lch2) v2) t3),
-                         H2ProjectByLabels (HCons (Proxy lch2) HNil) t6 t7 t4,
-                         H2ProjectByLabels (HCons e HNil) t4 t5 t3) =>
-                        e
-                        -> (Proxy lch2)
+(-->) ::                (HasField l2 t2 v2, HasField l3 r1 v1, HasField l3 r v,
+                         HRLabelSet (HCons (LVPair l3 v2) t6),
+                         H2ProjectByLabels (HCons l2 HNil) t2 t3 t4,
+                         H2ProjectByLabels (HCons l3 HNil) t4 t5 t6,
+                         HExtend (LVPair l2 v1) l1 t9, HExtend (LVPair l2 v) l t10) =>
+                        l2
+                        -> l3
                         -> (t, t1, r, r1)
-                        -> (t8, t9, Record t6, l1, l)
-                        -> (t8, t9, Record (HCons (LVPair (Proxy lch2) v2) t3), t10, t11)
+                        -> (t7, t8, Record t2, l1, l)
+                        -> (t7, t8, Record (HCons (LVPair l3 v2) t6), t9, t10)
+
 lch --> lch2 = \(_, _, sc, ici) (l1,ho1,ico1,ici1,sc1)  ->
-               let  ico1' = hRenameLabel lch lch2 (hDeleteAtLabel lch2 ico1)
+               let  ico1' = hRenameLabel' lch lch2 ico1 --(hDeleteAtLabel lch2 ico1)
                     ici1' = lch .=. (ici # lch2) .*. ici1
                     sc1'  = lch .=. (sc # lch2) .*. sc1
                in   (l1, ho1, ico1', ici1',  sc1')
 
+
+hRenameLabel' ::                (HasField l t v, HRLabelSet (HCons (LVPair l1 v) t4),
+                                 H2ProjectByLabels (HCons l1 HNil) t2 t3 t4,
+                                 H2ProjectByLabels (HCons l HNil) t t1 t2) =>
+                                l -> l1 -> Record t -> Record (HCons (LVPair l1 v) t4)
+hRenameLabel' l l' r = r'''
+ where
+  v    = hLookupByLabel l  r
+  r'   = hDeleteAtLabel l  r
+  r''  = hDeleteAtLabel l' r'
+  r''' = hExtend (newLVPair l' v) r''
+
 infixr 2 <.>
 
+
+ignore :: HExtend (LVPair lch (Record HNil)) l t6
+       => lch
+       -> (t, t1, t2, t3) -> (t4, t5, l, t7, t8) -> (t4, t5, t6, t7, t8)
+ignore lch2 = \(_, _, sc, ici) (l1,ho1,ico1,ici1,sc1)  ->
+               let  ico1' = lch2 .=. emptyRecord .*. ico1
+                    ici1' = ici1
+                    sc1'  = sc1
+               in   (l1, ho1, ico1', ici1',  sc1')
+
+
+noChild ::  (t, t1, t2, t3) -> (t4, t5, t6, t7, t8) -> (t4, t5, t6, t7, t8)
+noChild (_, _, _, _) = id
+
+
 -- | Composition of children mapping definitions for the function 'macro'.
 (<.>)  ::  ((lf,hof,sc,ici) -> (l2,ho2,ico1',ici1',sc1') -> (l3,ho3,ico1'',ici1'',sc1'')) 
        ->  ((lf,hof,sc,ici) -> (l1,ho1,ico1,ici1,sc1) -> (l2,ho2,ico1',ici1',sc1')) 
@@ -639,6 +675,20 @@ 
 
 
+withChild ::  HasField lch sc v 
+          =>  lch -> (v -> Rule lf hof sc ip l ho ic sp l' ho' ic' sp')
+          ->  Rule lf hof sc ip l ho ic sp l' ho' ic' sp'
+withChild lch rule (Fam lf hof sc ip) (Fam li hoi ici spi) =
+                   rule (sc # lch) (Fam lf hof sc ip) (Fam li hoi ici spi)
+
+
+withChildAtt ::  (HasField lch sc r, HasField att r v) 
+             =>  lch -> att -> (v -> Rule lf hof sc ip l ho ic sp l' ho' ic' sp')
+             ->  Rule lf hof sc ip l ho ic sp l' ho' ic' sp'
+withChildAtt lch att rule (Fam lf hof sc ip) (Fam li hoi ici spi) =
+                   rule ((sc # lch) # att) (Fam lf hof sc ip) (Fam li hoi ici spi)
+
+
 -- Monadic Interface 
 
 data Lhs
@@ -665,6 +715,13 @@        => At (Proxy Loc) m l where
   at _ = liftM (\(Fam l _ _ _) -> l) ask
 
+
+-- for the static case
+instance (MonadReader (Fam l ho chi par) m) 
+       => At (chi -> v) m v where
+  at lbl = liftM (\(Fam _ _ chi _) -> lbl chi) ask
+
+
 def :: Reader (Fam l ho chi par) a -> ((Fam l ho chi par) -> a)
 def = runReader
 
@@ -686,12 +743,22 @@ inhdefM att nts d inp  = inhdef att nts (def d inp)
 
 
+inh  ::  (Defs att nts a ic ic') 
+     =>  att-> nts-> Reader (Fam lf hof sc ip) a 
+     ->  Rule lf hof sc ip l ho ic sp l ho ic' sp
+inh = inhdefM
+
 syndefM  ::  (HExtend (Att att a) sp sp') 
          =>  att-> Reader (Fam lf hof sc ip) a 
          ->  Rule lf hof sc ip l ho ic sp l ho ic sp'
 syndefM att d inp  = syndef att (def d inp) 
 
 
+syn  ::  (HExtend (Att att a) sp sp') 
+     =>  att-> Reader (Fam lf hof sc ip) a 
+     ->  Rule lf hof sc ip l ho ic sp l ho ic sp'
+syn = syndefM
+
 inhmodM  ::  (Mods att nts a ic ic') 
          =>  att -> nts -> Reader (Fam lf hof sc ip) a 
          ->  Rule lf hof sc ip l ho ic sp l ho ic' sp
@@ -703,6 +770,7 @@          ->  Rule lf hof sc ip l ho ic (Record sp) l ho ic (Record sp') 
 synmodM att d inp    = synmod att (def d inp) 
 
+synupdM att d inp    = synupd att (def d inp) 
 
 
 -- | Field of an aspect. It associates a production 'prd' with a rule 'rule'.