language-c-quote 0.12.2.1 → 0.13

raw patch · 14 files changed

+205/−20 lines, 14 filesdep −symboldep ~bytestringdep ~haskell-src-metadep ~srclocPVP ok

version bump matches the API change (PVP)

Dependencies removed: symbol

Dependency ranges changed: bytestring, haskell-src-meta, srcloc

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• Language/C/Parser/Lexer.x +3/−2
• Language/C/Parser/Parser.y +29/−1
• Language/C/Parser/Tokens.hs +4/−0
• Language/C/Pretty.hs +14/−1
• Language/C/Quote.hs +0/−1
• Language/C/Quote/Base.hs +27/−0
• Language/C/Quote/GCC.hs +4/−2
• Language/C/Smart.hs +0/−1
• Language/C/Syntax-instances.hs +6/−0
• Language/C/Syntax.hs +3/−0
• language-c-quote.cabal +14/−11
• tests/unit/GCC.hs +61/−0
• tests/unit/Main.hs +28/−1

@@ -1,3 +1,12 @@+## [0.13] - 2021-04-29+### Added+ - Add quotation support for attributes (Richard Marko)+ - Add ranges to case labels as a GCC extension (Mark Barbone)+### Fixed+ - #81 Missing braces cause dangling-else+### Changed+ - Remove dependency on `symbol` package.+  ## [0.12.2.1] - 2019-10-04 ### Added  - Support for GHC 8.8.1.@@ -101,6 +110,9 @@ ### Changed - `Located` instances are also now automatically generated. +[0.13]: https://github.com/mainland/language-c-quote/compare/language-c-quote-0.12.2.1...language-c-quote-0.13+[0.12.2.1]: https://github.com/mainland/language-c-quote/compare/language-c-quote-0.12.2...language-c-quote-0.12.2.1+[0.12.2]: https://github.com/mainland/language-c-quote/compare/language-c-quote-0.12.1...language-c-quote-0.12.2 [0.12.1]: https://github.com/mainland/language-c-quote/compare/language-c-quote-0.12...language-c-quote-0.12.1 [0.12]: https://github.com/mainland/language-c-quote/compare/language-c-quote-0.11.7.2...language-c-quote-0.12 [0.11.7.3]: https://github.com/mainland/language-c-quote/compare/language-c-quote-0.11.7.2...language-c-quote-0.11.7.3

@@ -40,7 +40,6 @@ import qualified Data.Map as Map import Data.Ratio ((%)) import qualified Data.Set as Set-import Data.Symbol import Data.Maybe (fromMaybe) import Text.PrettyPrint.Mainland @@ -124,6 +123,8 @@  "$comment:" / { allowAnti } { lexAnti Tanti_comment }  "$init:"    / { allowAnti } { lexAnti Tanti_init }  "$inits:"   / { allowAnti } { lexAnti Tanti_inits }+ "$attr:"    / { allowAnti } { lexAnti Tanti_attr }+ "$attrs:"   / { allowAnti } { lexAnti Tanti_attrs }  "$"         / { allowAnti } { lexAnti Tanti_exp }   --@@ -317,7 +318,7 @@     s <- case c of            '('                 -> lexExpression 0 ""            _ | isIdStartChar c -> lexIdChars [c]-             | otherwise       -> lexerError beg (text "illegal anitquotation")+             | otherwise       -> lexerError beg (text "illegal antiquotation")     return $ locateTok beg end (antiTok s)   where     lexIdChars :: String -> P String

@@ -203,6 +203,9 @@  '__typeof__'        { L _ T.Ttypeof }  '__restrict'        { L _ T.T__restrict } + ANTI_ATTR        { L _ (T.Tanti_attr _) }+ ANTI_ATTRS       { L _ (T.Tanti_attrs _) }+  --  -- Clang blocks  --@@ -322,6 +325,8 @@ %name parseUnit       translation_unit %name parseFunc       function_definition +%name parseAttr       attrib+ -- -- Objective-C --@@ -2061,9 +2066,19 @@ labeled_statement :     identifier ':' error                      {% expected ["statement"] (Just "label") }   | identifier ':' statement                  { Label $1 [] $3 ($1 `srcspan` $3) }-  | 'case' constant_expression error          {% expected ["`:'"] Nothing }+  | 'case' constant_expression error+    {% do { gcc_enabled <- useGccExts+          ; let options = if gcc_enabled then ["`:'", "`...'"] else ["`:'"]+          ; expected options Nothing } }   | 'case' constant_expression ':' error      {% expected ["statement"] Nothing }   | 'case' constant_expression ':' statement  { Case $2 $4 ($1 `srcspan` $4) }+  | 'case' constant_expression '...' constant_expression error+    {% expected ["`:'"] Nothing }+  | 'case' constant_expression '...' constant_expression ':' error+    {% expected ["statement"] Nothing }+  | 'case' constant_expression '...' constant_expression ':' statement+    {% gccOnly "To use ranges in case statements, enable GCC extensions"+        $ CaseRange $2 $4 $6 ($1 `srcspan` $6) }   | 'default' error                           {% expected ["`:'"] (Just "`default'")}   | 'default' ':' error                       {% expected ["statement"] Nothing }   | 'default' ':' statement                   { Default $3 ($1 `srcspan` $3) }@@ -2327,6 +2342,8 @@ attribute_rlist :     attrib                     { rsingleton $1 }   | attribute_rlist ',' attrib { rcons $3 $1 }+  | ANTI_ATTRS+     { rsingleton $ AntiAttrs (getANTI_ATTRS $1) (srclocOf $1) }  attrib :: { Attr } attrib :@@ -2334,6 +2351,8 @@       { Attr $1 [] (srclocOf $1)}   | attrib_name '(' argument_expression_list ')'       { Attr $1 $3 ($1 `srcspan` $4) }+  | ANTI_ATTR+     { AntiAttr (getANTI_ATTR $1) (srclocOf $1) }  attrib_name :: { Id } attrib_name :@@ -3391,6 +3410,8 @@ getANTI_COMMENT     (L _ (T.Tanti_comment v))     = v getANTI_INIT        (L _ (T.Tanti_init v))        = v getANTI_INITS       (L _ (T.Tanti_inits v))       = v+getANTI_ATTR        (L _ (T.Tanti_attr v))        = v+getANTI_ATTRS       (L _ (T.Tanti_attrs v))       = v  -- -- Objective-C@@ -4008,6 +4029,13 @@  cuda_enabled <- useCUDAExts  unless cuda_enabled $   throw $ ParserException loc $ text errMsg++gccOnly :: Located a => String -> a -> P a+gccOnly errMsg x = do+  gcc_enabled <- useGccExts+  unless gcc_enabled $+    throw $ ParserException (locOf x) $ text errMsg+  pure x  mkBlock :: [BlockItem] -> SrcLoc -> Stm mkBlock items@[BlockStm AntiStms{}] sloc = Block items sloc

@@ -166,6 +166,8 @@            | Tanti_comment String            | Tanti_init String            | Tanti_inits String+           | Tanti_attr String+           | Tanti_attrs String             -- C99            | TBool@@ -314,6 +316,8 @@     show (Tanti_comment s)              = showAnti "comment"  s     show (Tanti_init s)                 = showAnti "init"  s     show (Tanti_inits s)                = showAnti "inits"  s+    show (Tanti_attr s)                 = showAnti "attr"  s+    show (Tanti_attrs s)                = showAnti "attrs"  s      --     -- Objective C

@@ -473,6 +473,9 @@     ppr (Attr ident args _) =         ppr ident <> parens (commasep (map ppr args)) +    ppr (AntiAttr v _)   = pprAnti "attr" v+    ppr (AntiAttrs v _)  = pprAnti "attrs" v+     pprList []    = empty     pprList attrs = text "__attribute__" <>                     parens (parens (commasep (map ppr attrs)))@@ -582,6 +585,10 @@         srcloc sloc <>         indent (-2) (line <> text "case" <+> ppr e <> colon) </> ppr stm +    ppr (CaseRange e1 e2 stm sloc) =+        srcloc sloc <>+        indent (-2) (line <> text "case" <+> ppr e1 <+> text "..." <+> ppr e2 <> colon) </> ppr stm+     ppr (Default stm sloc) =         srcloc sloc <>         indent (-2) (line <> text "default" <> colon) </> ppr stm@@ -600,9 +607,15 @@         text "if" <+> parens (ppr test) <>         pprThen then' (fmap pprElse maybe_else)       where+        isIf :: Stm -> Bool+        isIf If{} = True+        isIf (Comment _ stm _) = isIf stm+        isIf _ = False+         pprThen :: Stm -> Maybe Doc -> Doc         pprThen stm@(Block {}) rest        = space <> ppr stm <+> maybe empty id rest-        pprThen stm@(If {})    rest        = space <> ppr [BlockStm stm] <+> maybe empty id rest+        pprThen stm            rest+          | isIf stm                       = space <> ppr [BlockStm stm] <+> maybe empty id rest         pprThen stm            Nothing     = nest 4 (line <> ppr stm)         pprThen stm            (Just rest) = nest 4 (line <> ppr stm) </> rest 

@@ -18,7 +18,6 @@ -- imports to any module using the quasiquoters provided by this package: -- -- > import qualified Data.Loc--- > import qualified Data.Symbol -- > import qualified Language.C.Syntax -- -- These modules may also be imported unqualified, of course. The quasiquoters

@@ -276,6 +276,17 @@ qqInitGroupListE (ini : inis) =     Just [|$(dataToExpQ qqExp ini) : $(dataToExpQ qqExp inis)|] +qqAttrE :: C.Attr -> Maybe (Q Exp)+qqAttrE (C.AntiAttr v _)  = Just $ antiVarE v+qqAttrE _                 = Nothing++qqAttrListE :: [C.Attr] -> Maybe (Q Exp)+qqAttrListE [] = Just [|[]|]+qqAttrListE (C.AntiAttrs v _ : attrs) =+    Just [|$(antiVarE v) ++ $(dataToExpQ qqExp attrs)|]+qqAttrListE (field : fields) =+    Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]+ qqFieldGroupE :: C.FieldGroup -> Maybe (Q Exp) qqFieldGroupE (C.AntiSdecl v _)  = Just $ antiVarE v qqFieldGroupE _                  = Nothing@@ -502,6 +513,8 @@                        `extQ` qqInitializerListE                        `extQ` qqInitGroupE                        `extQ` qqInitGroupListE+                       `extQ` qqAttrE+                       `extQ` qqAttrListE                        `extQ` qqFieldGroupE                        `extQ` qqFieldGroupListE                        `extQ` qqCEnumE@@ -593,6 +606,18 @@ qqInitGroupListP (ini : inis) =     Just $ conP (mkName ":") [dataToPatQ qqPat ini,  dataToPatQ qqPat inis] +qqAttrP :: C.Attr -> Maybe (Q Pat)+qqAttrP (C.AntiAttr v _)  = Just $ antiVarP v+qqAttrP _                 = Nothing++qqAttrListP :: [C.Attr] -> Maybe (Q Pat)+qqAttrListP [] = Just $ listP []+qqAttrListP [C.AntiAttrs v _] = Just $ antiVarP v+qqAttrListP (C.AntiAttrs{} : _ : _) =+   error "Antiquoted list of attrs must be last item in quoted list"+qqAttrListP (ini : inis) =+    Just $ conP (mkName ":") [dataToPatQ qqPat ini,  dataToPatQ qqPat inis]+ qqFieldGroupP :: C.FieldGroup -> Maybe (Q Pat) qqFieldGroupP (C.AntiSdecl v _) = Just $ antiVarP v qqFieldGroupP _                 = Nothing@@ -727,6 +752,8 @@                       `extQ` qqInitializerListP                       `extQ` qqInitGroupP                       `extQ` qqInitGroupListP+                      `extQ` qqAttrP+                      `extQ` qqAttrListP                       `extQ` qqFieldGroupP                       `extQ` qqCEnumP                       `extQ` qqCEnumListP

@@ -25,7 +25,8 @@     citem,     citems,     cunit,-    cfun+    cfun,+    cattr   ) where  import qualified Language.C.Parser as P@@ -40,7 +41,7 @@ typenames = []  cdecl, cedecl, cenum, cexp, cfun, cinit, cparam, cparams, csdecl, cstm, cstms :: QuasiQuoter-citem, citems, ctyquals, cty, cunit :: QuasiQuoter+citem, citems, ctyquals, cty, cunit, cattr :: QuasiQuoter cdecl    = quasiquote exts typenames P.parseDecl cedecl   = quasiquote exts typenames P.parseEdecl cenum    = quasiquote exts typenames P.parseEnum@@ -57,3 +58,4 @@ ctyquals = quasiquote exts typenames P.parseTypeQuals cty      = quasiquote exts typenames P.parseType cunit    = quasiquote exts typenames P.parseUnit+cattr    = quasiquote exts typenames P.parseAttr

@@ -16,7 +16,6 @@  #if !MIN_VERSION_template_haskell(2,7,0) import qualified Data.Loc-import qualified Data.Symbol import qualified Language.C.Syntax #endif /* !MIN_VERSION_template_haskell(2,7,0) */ 

@@ -114,6 +114,8 @@   locOf (AntiEnums _ l) = locOf l instance Located Attr where   locOf (Attr _ _ l) = locOf l+  locOf (AntiAttr _ l) = locOf l+  locOf (AntiAttrs _ l) = locOf l instance Located Param where   locOf (Param _ _ _ l) = locOf l   locOf (AntiParam _ l) = locOf l@@ -147,6 +149,7 @@ instance Located Stm where   locOf (Label _ _ _ l) = locOf l   locOf (Case _ _ l) = locOf l+  locOf (CaseRange _ _ _ l) = locOf l   locOf (Default _ l) = locOf l   locOf (Exp _ l) = locOf l   locOf (Block _ l) = locOf l@@ -420,6 +423,8 @@   reloc l (AntiEnums x0 _) = (AntiEnums x0 (fromLoc l)) instance Relocatable Attr where   reloc l (Attr x0 x1 _) = (Attr x0 x1 (fromLoc l))+  reloc l (AntiAttr x0 _) = (AntiAttr x0 (fromLoc l))+  reloc l (AntiAttrs x0 _) = (AntiAttrs x0 (fromLoc l)) instance Relocatable Param where   reloc l (Param x0 x1 x2 _) = (Param x0 x1 x2 (fromLoc l))   reloc l (AntiParam x0 _) = (AntiParam x0 (fromLoc l))@@ -457,6 +462,7 @@ instance Relocatable Stm where   reloc l (Label x0 x1 x2 _) = (Label x0 x1 x2 (fromLoc l))   reloc l (Case x0 x1 _) = (Case x0 x1 (fromLoc l))+  reloc l (CaseRange x0 x1 x2 _) = (CaseRange x0 x1 x2 (fromLoc l))   reloc l (Default x0 _) = (Default x0 (fromLoc l))   reloc l (Exp x0 _) = (Exp x0 (fromLoc l))   reloc l (Block x0 _) = (Block x0 (fromLoc l))

@@ -195,6 +195,8 @@     deriving (Eq, Ord, Show, Data, Typeable)  data Attr  =  Attr Id [Exp] !SrcLoc+           | AntiAttr String !SrcLoc+           | AntiAttrs String !SrcLoc     deriving (Eq, Ord, Show, Data, Typeable)  data Param  =  Param (Maybe Id) DeclSpec Decl !SrcLoc@@ -236,6 +238,7 @@  data Stm  = Label Id [Attr] Stm !SrcLoc           | Case Exp Stm !SrcLoc+          | CaseRange Exp Exp Stm !SrcLoc           | Default Stm !SrcLoc           | Exp (Maybe Exp) !SrcLoc           | Block [BlockItem] !SrcLoc

@@ -1,5 +1,5 @@ name:          language-c-quote-version:       0.12.2.1+version:       0.13 cabal-version: >= 1.10 license:       BSD3 license-file:  LICENSE@@ -15,7 +15,8 @@ category:      Language synopsis:      C/CUDA/OpenCL/Objective-C quasiquoting library. tested-with:   GHC==7.4.2, GHC==7.6.3, GHC==7.8.3, GHC==7.10.3, GHC==8.0.2,-               GHC==8.2.2, GHC==8.4.3, GHC==8.6.5, GHC==8.8.1+               GHC==8.2.2, GHC==8.4.3, GHC==8.6.5, GHC==8.8.4, GHC==8.10.4,+               GHC==9.0.1  description:   This package provides a general parser for the C language, including most GCC@@ -36,7 +37,7 @@   manual:      True  library-  default-language: Haskell98+  default-language: Haskell2010    build-depends:     array                  >= 0.2   && < 0.6,@@ -48,19 +49,21 @@     filepath               >= 1.2   && < 1.5,     mainland-pretty        >= 0.7   && < 0.8,     mtl                    >= 2.0   && < 3,-    srcloc                 >= 0.4   && < 0.6,+    srcloc                 >= 0.4   && < 0.7,     syb                    >= 0.3   && < 0.8,-    symbol                 >= 0.1   && < 0.3,     template-haskell    if flag(full-haskell-antiquotes)     if impl(ghc < 7.8)       build-depends: safe <= 0.3.9 -    if impl(ghc >= 7.6)-      build-depends: haskell-src-meta >= 0.4 && < 0.9+    if impl(ghc >= 8.0) && impl(ghc < 8.1)+      build-depends: haskell-src-meta >= 0.4 && < 0.8.7     else-      build-depends: haskell-src-meta >= 0.4 && < 0.7+      if impl(ghc >= 7.6)+        build-depends: haskell-src-meta >= 0.4 && < 0.9+      else+        build-depends: haskell-src-meta >= 0.4 && < 0.7   else     build-depends: haskell-exp-parser >= 0.1 && < 0.2 @@ -105,10 +108,11 @@   main-is:          Main.hs   other-modules:     CUDA+    GCC     Objc     MainCPP -  default-language: Haskell98+  default-language: Haskell2010    build-depends:     HUnit                >= 1.2 && < 1.7,@@ -116,8 +120,7 @@     bytestring           >= 0.9 && < 0.11,     language-c-quote,     mainland-pretty      >= 0.7 && < 0.8,-    srcloc               >= 0.4 && < 0.6,-    symbol               >= 0.1 && < 0.3,+    srcloc               >= 0.4 && < 0.7,     test-framework       >= 0.8 && < 0.9,     test-framework-hunit >= 0.3 && < 0.4 

@@ -0,0 +1,61 @@+{-# LANGUAGE QuasiQuotes #-}++module GCC (+    gccTests+  ) where++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit (Assertion, assert, (@?=))++import qualified Data.ByteString.Char8 as B+import Data.Char (isSpace)+import Data.Loc (SrcLoc, noLoc, startPos)+import Control.Exception (SomeException)+import Language.C.Quote.GCC+import Language.C.Smart ()+import qualified Language.C.Syntax as C+import qualified Language.C.Parser as P+import Text.PrettyPrint.Mainland+import Text.PrettyPrint.Mainland.Class++gccTests :: Test+gccTests = testGroup "GCC attribute quotations"+    [ testCase "attr antiquote" test_attr+    , testCase "attrs antiquote" test_attrs+    , testCase "attrs antiquote pretty" test_attr_p+    , testCase "case ranges quote" test_case_ranges+    , testCase "case ranges pretty" test_case_ranges_p+    ]+  where+    test_attr :: Assertion+    test_attr =+         [cedecl| int test __attribute__(($attr:a,$attr:b));|]+           @?=+         [cedecl| int test __attribute__((section(".sram2"), noinit));|]+      where+        a = [cattr| section(".sram2") |]+        b = [cattr| noinit |]++    test_attrs :: Assertion+    test_attrs =+         [cedecl| int test __attribute__(($attrs:as));|]+           @?=+         [cedecl| int test __attribute__((section(".sram2"), noinit));|]+      where+        a = [cattr| section(".sram2") |]+        b = [cattr| noinit |]+        as = [ a, b ]++    test_attr_p :: Assertion+    test_attr_p =+      pretty 80 (ppr [cattr|section(".sram2")|]) @?= "section(\".sram2\")"++    test_case_ranges :: Assertion+    test_case_ranges = assert $ case [cstm| case 10 ... 20: ; |] of+      C.CaseRange 10 20 (C.Exp Nothing _) _ -> True+      _ -> False++    test_case_ranges_p :: Assertion+    test_case_ranges_p =+      pretty 80 (ppr [cstm| case 10 ... 20: ; |]) @?= "\ncase 10 ... 20:\n;"

@@ -11,10 +11,12 @@ import Data.Loc (SrcLoc, noLoc, startPos) import Control.Exception (SomeException) import Language.C.Quote.C+import qualified Language.C.Quote.GCC as GCC import qualified Language.C.Syntax as C import qualified Language.C.Parser as P import MainCPP import Numeric (showHex)+import GCC (gccTests) import Objc (objcTests, objcRegressionTests) import CUDA (cudaTests) import Text.PrettyPrint.Mainland@@ -30,6 +32,7 @@         , cPatternAntiquotationTests         , statementCommentTests         , regressionTests+        , gccTests         , objcTests         , objcRegressionTests         , cudaTests@@ -490,7 +493,9 @@  regressionTests :: Test regressionTests = testGroup "Regressions"-    [ issue68+    [ issue81+    , issue76+    , issue68     , issue64     , testCase "pragmas" test_pragmas     , issue48@@ -518,6 +523,28 @@                       ]                       noLoc             ]++    issue81 :: Test+    issue81 = testCase "Issue #81"$+        showCompact [cstm|if (x > 1) { /* comment */ if (x > 2) x++; }|]+        @?=+        "if (x > 1) { /* comment */ if (x > 2) x++; }"++    issue76 :: Test+    issue76 = testCase "Issue #76" $+        [cunit|+          /* AAA */+          struct A { int foo; };+          /* BBB */+          struct B { int bar; };+        |]+        @?=+        [cunit|+          /* AAA */+          struct A { int foo; };+          $comment:(" BBB ")+          struct B { int bar; };+        |]      issue68 :: Test     issue68 = testCase "Issue #68"$