feat: Some extensions to the syntax.

BUILD.bazel

@@ -27,6 +27,20 @@ haskell_library(
     ],
 )
 
+haskell_library(
+    name = "ast",
+    srcs = ["src/Language/Cimple/Ast.hs"],
+    src_strip_prefix = "src",
+    visibility = ["//hs-cimple:__subpackages__"],
+    deps = [
+        ":lexer",
+        hazel_library("aeson"),
+        hazel_library("base"),
+        hazel_library("data-fix"),
+        hazel_library("transformers-compat"),
+    ],
+)
+
 happy_parser(
     name = "Parser",
     src = "src/Language/Cimple/Parser.y",
@@ -35,13 +49,11 @@ happy_parser(
 
 haskell_library(
     name = "parser",
-    srcs = [
-        "src/Language/Cimple/Ast.hs",
-        "src/Language/Cimple/Parser.hs",
-    ],
+    srcs = [":Parser"],
     src_strip_prefix = "src",
     visibility = ["//hs-cimple:__subpackages__"],
     deps = [
+        ":ast",
         ":lexer",
         hazel_library("aeson"),
         hazel_library("array"),
@@ -60,12 +72,12 @@ happy_parser(
 
 haskell_library(
     name = "tree_parser",
-    srcs = ["src/Language/Cimple/TreeParser.hs"],
+    srcs = [":TreeParser"],
     src_strip_prefix = "src",
     visibility = ["//hs-cimple:__subpackages__"],
     deps = [
+        ":ast",
         ":lexer",
-        ":parser",
         hazel_library("array"),
         hazel_library("base"),
         hazel_library("data-fix"),
@@ -86,6 +98,7 @@ haskell_library(
     version = "0.0.15",
     visibility = ["//visibility:public"],
     deps = [
+        ":ast",
         ":lexer",
         ":parser",
         ":tree_parser",

src/Language/Cimple/Ast.hs

@@ -18,7 +18,7 @@ module Language.Cimple.Ast
 import           Data.Aeson                   (FromJSON, FromJSON1, ToJSON,
                                                ToJSON1)
 import           Data.Fix                     (Fix)
-import           Data.Functor.Classes         (Eq1, Read1, Show1)
+import           Data.Functor.Classes         (Eq1, Ord1, Read1, Show1)
 import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))
 import           GHC.Generics                 (Generic, Generic1)
 
@@ -104,6 +104,7 @@ data NodeF lexeme a
     | TyStd lexeme
     | TyUserDefined lexeme
     -- Functions
+    | AttrPrintf lexeme lexeme a
     | FunctionDecl Scope a
     | FunctionDefn Scope a a
     | FunctionPrototype a lexeme [a]
@@ -113,8 +114,8 @@ data NodeF lexeme a
     -- Constants
     | ConstDecl a lexeme
     | ConstDefn Scope a lexeme a
-    deriving (Show, Read, Eq, Generic, Generic1, Functor, Foldable, Traversable)
-    deriving (Show1, Read1, Eq1) via FunctorClassesDefault (NodeF lexeme)
+    deriving (Show, Read, Eq, Ord, Generic, Generic1, Functor, Foldable, Traversable)
+    deriving (Show1, Read1, Eq1, Ord1) via FunctorClassesDefault (NodeF lexeme)
 
 type Node lexeme = Fix (NodeF lexeme)
 
@@ -133,7 +134,7 @@ data AssignOp
     | AopMod
     | AopLsh
     | AopRsh
-    deriving (Show, Read, Eq, Generic)
+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)
 
 instance FromJSON AssignOp
 instance ToJSON AssignOp
@@ -157,7 +158,7 @@ data BinaryOp
     | BopGt
     | BopGe
     | BopRsh
-    deriving (Show, Read, Eq, Generic)
+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)
 
 instance FromJSON BinaryOp
 instance ToJSON BinaryOp
@@ -170,7 +171,7 @@ data UnaryOp
     | UopDeref
     | UopIncr
     | UopDecr
-    deriving (Show, Read, Eq, Generic)
+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)
 
 instance FromJSON UnaryOp
 instance ToJSON UnaryOp
@@ -181,24 +182,26 @@ data LiteralType
     | Bool
     | String
     | ConstId
-    deriving (Show, Read, Eq, Generic)
+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)
 
 instance FromJSON LiteralType
 instance ToJSON LiteralType
 
 data Scope
     = Global
     | Static
-    deriving (Show, Read, Eq, Generic)
+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)
 
 instance FromJSON Scope
 instance ToJSON Scope
 
 data CommentStyle
     = Regular
     | Doxygen
+    | Section
     | Block
-    deriving (Show, Read, Eq, Generic)
+    | Ignore
+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)
 
 instance FromJSON CommentStyle
 instance ToJSON CommentStyle

src/Language/Cimple/Lexer.x

@@ -29,7 +29,7 @@ import           Language.Cimple.Tokens (LexemeClass (..))
 tokens :-
 
 -- Ignore attributes.
-<0>		"GNU_PRINTF("[^\)]+")"			;
+<0>		"GNU_PRINTF"				{ mkL KwGnuPrintf }
 <0>		"VLA"					{ mkL KwVla }
 
 -- Winapi functions.
@@ -104,12 +104,7 @@ tokens :-
 <0>		"msgpack_zone"				{ mkL IdSueType }
 
 -- Sodium constants.
-<0,ppSC>	"crypto_auth_"[A-Z][A-Z0-9_]*		{ mkL IdConst }
-<0,ppSC>	"crypto_box_"[A-Z][A-Z0-9_]*		{ mkL IdConst }
-<0,ppSC>	"crypto_hash_sha256_"[A-Z][A-Z0-9_]*	{ mkL IdConst }
-<0,ppSC>	"crypto_hash_sha512_"[A-Z][A-Z0-9_]*	{ mkL IdConst }
-<0,ppSC>	"crypto_pwhash_scryptsalsa208sha256_"[A-Z][A-Z0-9_]*		{ mkL IdConst }
-<0,ppSC>	"crypto_sign_"[A-Z][A-Z0-9_]*		{ mkL IdConst }
+<0,ppSC>	"crypto_"[a-z0-9_]+[A-Z][A-Z0-9_]*	{ mkL IdConst }
 
 -- Standard C (ish).
 <ppSC>		defined					{ mkL PpDefined }
@@ -118,13 +113,13 @@ tokens :-
 <ppSC>		\\\n					;
 <ppSC>		$white					;
 
-<ignoreSC>	"//!TOKSTYLE+"				{ start 0 }
-<ignoreSC>	[.\n]					;
+<ignoreSC>	"//!TOKSTYLE+"				{ mkL IgnEnd `andBegin` 0 }
+<ignoreSC>	([^\/]+|.|\n)				{ mkL IgnBody }
 
 <0,ppSC>	"//"\n					;
 <0,ppSC>	"// ".*					;
 <0>		$white+					;
-<0>		"//!TOKSTYLE-"				{ start ignoreSC }
+<0>		"//!TOKSTYLE-"				{ mkL IgnStart `andBegin` ignoreSC }
 <0>		"/*"					{ mkL CmtStart `andBegin` cmtSC }
 <0>		"/**"					{ mkL CmtStartDoc `andBegin` cmtSC }
 <0>		"/** @{"				{ mkL CmtStartDocSection `andBegin` cmtSC }
@@ -275,12 +270,13 @@ tokens :-
 <0,ppSC,cmtSC,codeSC>	.				{ mkL Error }
 
 {
+deriving instance Ord AlexPosn
 deriving instance Generic AlexPosn
 instance FromJSON AlexPosn
 instance ToJSON AlexPosn
 
 data Lexeme text = L AlexPosn LexemeClass text
-    deriving (Show, Eq, Generic, Functor, Foldable, Traversable)
+    deriving (Ord, Eq, Show, Generic, Functor, Foldable, Traversable)
 
 instance FromJSON text => FromJSON (Lexeme text)
 instance ToJSON text => ToJSON (Lexeme text)

src/Language/Cimple/MapAst.hs

@@ -248,6 +248,8 @@ instance MapAst itext otext (Node (Lexeme itext)) where
             Fix <$> (TyStd <$> recurse name)
         TyUserDefined name ->
             Fix <$> (TyUserDefined <$> recurse name)
+        AttrPrintf fmt ellipsis fun ->
+            Fix <$> (AttrPrintf <$> recurse fmt <*> recurse ellipsis <*> recurse fun)
         FunctionDecl scope proto ->
             Fix <$> (FunctionDecl scope <$> recurse proto)
         FunctionDefn scope proto body ->

src/Language/Cimple/Parser.y

@@ -22,7 +22,7 @@ import           Language.Cimple.Tokens (LexemeClass (..))
 %errorhandlertype explist
 %lexer {lexwrap} {L _ Eof _}
 %monad {Alex}
-%tokentype {Lexeme String}
+%tokentype {StringLexeme}
 %token
     ID_CONST			{ L _ IdConst			_ }
     ID_FUNC_TYPE		{ L _ IdFuncType		_ }
@@ -39,6 +39,7 @@ import           Language.Cimple.Tokens (LexemeClass (..))
     enum			{ L _ KwEnum			_ }
     extern			{ L _ KwExtern			_ }
     for				{ L _ KwFor			_ }
+    GNU_PRINTF			{ L _ KwGnuPrintf		_ }
     goto			{ L _ KwGoto			_ }
     if				{ L _ KwIf			_ }
     non_null			{ L _ KwNonNull			_ }
@@ -130,6 +131,9 @@ import           Language.Cimple.Tokens (LexemeClass (..))
     CMT_COMMAND			{ L _ CmtCommand		_ }
     CMT_WORD			{ L _ CmtWord			_ }
     CMT_REF			{ L _ CmtRef			_ }
+    IGN_START			{ L _ IgnStart			_ }
+    IGN_BODY			{ L _ IgnBody			_ }
+    IGN_END			{ L _ IgnEnd			_ }
 
 %left ','
 %right '=' '+=' '-=' '*=' '/=' '%=' '<<=' '>>=' '&=' '^=' '|='
@@ -205,9 +209,10 @@ Comment :: { StringNode }
 Comment
 :	'/*' CommentTokens '*/'					{ Fix $ Comment Regular $1 (reverse $2) $3 }
 |	'/**' CommentTokens '*/'				{ Fix $ Comment Doxygen $1 (reverse $2) $3 }
-|	'/** @{' CommentTokens '*/'				{ Fix $ Comment Block $1 (reverse $2) $3 }
+|	'/** @{' CommentTokens '*/'				{ Fix $ Comment Section $1 (reverse $2) $3 }
 |	'/***' CommentTokens '*/'				{ Fix $ Comment Block $1 (reverse $2) $3 }
 |	'/** @} */'						{ Fix $ CommentSectionEnd $1 }
+|	Ignore							{ $1 }
 
 CommentTokens :: { [StringLexeme] }
 CommentTokens
@@ -248,6 +253,15 @@ CommentWord
 |	'-'							{ $1 }
 |	'='							{ $1 }
 
+Ignore :: { StringNode }
+Ignore
+:	IGN_START IgnoreBody IGN_END				{ Fix $ Comment Ignore $1 (reverse $2) $3 }
+
+IgnoreBody :: { [StringLexeme] }
+IgnoreBody
+:	IGN_BODY						{ [$1] }
+|	IgnoreBody IGN_BODY					{ $2 : $1 }
+
 PreprocIfdef(decls)
 :	'#ifdef' ID_CONST decls PreprocElse(decls) '#endif'	{ Fix $ PreprocIfdef $2 (reverse $3) $4 }
 |	'#ifndef' ID_CONST decls PreprocElse(decls) '#endif'	{ Fix $ PreprocIfndef $2 (reverse $3) $4 }
@@ -329,6 +343,7 @@ Stmt
 |	ForStmt							{ $1 }
 |	WhileStmt						{ $1 }
 |	DoWhileStmt						{ $1 }
+|	StaticAssert						{ $1 }
 |	AssignExpr ';'						{ Fix $ ExprStmt $1 }
 |	ExprStmt ';'						{ Fix $ ExprStmt $1 }
 |	FunctionCall ';'					{ Fix $ ExprStmt $1 }
@@ -439,7 +454,7 @@ PreprocSafeExpr(x)
 :	LiteralExpr						{ $1 }
 |	'(' x ')'						{ Fix $ ParenExpr $2 }
 |	'(' QualType ')' x %prec CAST				{ Fix $ CastExpr $2 $4 }
-|	sizeof '(' x ')'					{ Fix $ SizeofExpr $3 }
+|	sizeof '(' Expr ')'					{ Fix $ SizeofExpr $3 }
 |	sizeof '(' QualType ')'					{ Fix $ SizeofType $3 }
 
 ConstExpr :: { StringNode }
@@ -579,7 +594,7 @@ Enumerator
 |	EnumeratorName '=' ConstExpr ','			{ Fix $ Enumerator $1 (Just $3) }
 |	Comment							{ $1 }
 
-EnumeratorName :: { Lexeme String }
+EnumeratorName :: { StringLexeme }
 EnumeratorName
 :	ID_CONST						{ $1 }
 |	ID_SUE_TYPE						{ $1 }
@@ -644,6 +659,11 @@ FunctionDecl
 |	static FunctionDeclarator				{ $2 Static }
 |	NonNull FunctionDeclarator				{ $1 $ $2 Global }
 |	NonNull static FunctionDeclarator			{ $1 $ $3 Static }
+|	NonNull Attrs FunctionDeclarator			{ $1 . $2 . $3 $ Global }
+
+Attrs :: { StringNode -> StringNode }
+Attrs
+:	GNU_PRINTF '(' LIT_INTEGER ',' LIT_INTEGER ')'		{ Fix . AttrPrintf $3 $5 }
 
 NonNull :: { StringNode -> StringNode }
 NonNull