AspectAG 0.3.6 → 0.3.6.1

raw patch · 2 files changed

+34/−11 lines, 2 filesdep ~HListPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: HList

API changes (from Hackage documentation)

Files

• AspectAG.cabal +1/−1
• src/Language/Grammars/AspectAG/Derive.hs +33/−10

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

@@ -1,12 +1,12 @@ {-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS -XEmptyDataDecls #-} -module Language.Grammars.AspectAG.Derive (deriveAG, extendAG, addNT, addProd, attLabel, attLabels, chLabel, chLabels) where+module Language.Grammars.AspectAG.Derive (deriveAG, extendAG, deriveLang, addNT, addProd, attLabel, attLabels, chLabel, chLabels) where  import Language.Haskell.TH  import Data.Set (Set)-import Data.List (isPrefixOf, isSuffixOf)+import Data.List (isPrefixOf, isSuffixOf, sort) import qualified Data.Set as S  import Language.Grammars.AspectAG@@ -24,11 +24,11 @@             return $ dtl:lbl  declareFnLabel ::  Name -> TypeQ -> Q [Dec]-declareFnLabel nlabel t = do -            sgn <- sigD nlabel (appT (conT $ mkName "Proxy") t)  -            let pxy = normalB [| proxy |]-            lbl <- funD nlabel [clause [] pxy []]-            return [sgn,lbl]+declareFnLabel nlabel t = +             do sgn <- sigD nlabel (appT (conT $ mkName "Proxy") t)  +                let pxy = normalB [| proxy |]+                lbl <- funD nlabel [clause [] pxy []]+                return [sgn,lbl]  attLabel ::  String -> Q [Dec] attLabel att = declareLabel attn (mkName att) (conT $ attn) @@ -108,9 +108,11 @@                in  do                       (UserD _ _ lc) <- getUserType info                       ((s,d),fc)   <- foldM deriveCons ((stn',decl),[]) lc-                      let semDecl = FunD (semName n) fc-                      nt <- declareFnLabel (ntName n) (conT $ n)-                      return (s,semDecl:(nt++d))+                      if (isPrefixOf "EXT" (nameBase n))  -- type extensions start with EXT+                       then return (s,d)                      +                       else do let semDecl = FunD (semName n) fc+                               nt <- declareFnLabel (ntName n) (conT $ n)+                               return (s,semDecl:(nt++d))  deriveCons :: (TypeDecls,[Clause]) -> Con -> Q (TypeDecls,[Clause]) deriveCons ((stn,decl),fc) c =                     @@ -259,3 +261,24 @@   +mkNames (_,fields,cname) = ( mkName ('p' : nameBase cname)+                           , mkName ('_' : nameBase cname)+                           , map (\n -> mkName ('_' : nameBase n)) fields)++recField (pc,c,fs) = (pc, NotStrict, foldr (\n t -> AppT (AppT ArrowT (VarT n)) t) (VarT c) fs)++deriveLang :: String -> [Name] -> Q [Dec]+deriveLang l ns =  +  let recName = mkName (l ++ "SF")+  in  do cs <- mapM getCs ns +         let names = sort $ map (mkNames . getCtx) (concat cs)+         let ts = map (\(_,c,fs) -> (PlainTV c) : (map PlainTV fs)) names+         let rec = DataD [] recName (concat ts) [RecC recName (map recField names) ] []+         let semp t = VarE $ mkName ("semP"++(nameBase t))+         let body = NormalB $ RecConE recName (map  (\(pc,_c,_) -> (pc, AppE (semp _c) (VarE _c)) ) names)+         let mk  = FunD  (mkName ("mk" ++ l)) [ Clause (map (\(_,c,_) -> VarP c) names) body [] ]+         return [ rec, mk ]++getCs n =  do info <- reify n +              (UserD _ _ lc) <- getUserType info+              return lc