From f9157a141c4faffa333d4dd3ea04becab148943d Mon Sep 17 00:00:00 2001
From: iphydf <iphydf@users.noreply.github.com>
Date: Sat, 3 Feb 2024 21:18:35 +0000
Subject: [PATCH] feat: Add support for `bitwise` attribute for strong
 typedefs.

The `sparse` tool can validate these.
---
 src/Language/Cimple/Ast.hs         | 2 ++
 src/Language/Cimple/Lexer.x        | 2 ++
 src/Language/Cimple/MapAst.hs      | 4 ++++
 src/Language/Cimple/Parser.y       | 6 +++++-
 src/Language/Cimple/Pretty.hs      | 4 ++++
 src/Language/Cimple/Tokens.hs      | 2 ++
 src/Language/Cimple/TraverseAst.hs | 4 ++++
 7 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/src/Language/Cimple/Ast.hs b/src/Language/Cimple/Ast.hs
index 0409d28..129a584 100644
--- a/src/Language/Cimple/Ast.hs
+++ b/src/Language/Cimple/Ast.hs
@@ -102,6 +102,8 @@ data NodeF lexeme a
     | Struct lexeme [a]
     | Union lexeme [a]
     | MemberDecl a (Maybe lexeme)
+    | TyBitwise a
+    | TyForce a
     | TyConst a
     | TyPointer a
     | TyStruct lexeme
diff --git a/src/Language/Cimple/Lexer.x b/src/Language/Cimple/Lexer.x
index c2311f1..a635f37 100644
--- a/src/Language/Cimple/Lexer.x
+++ b/src/Language/Cimple/Lexer.x
@@ -151,6 +151,7 @@ tokens :-
 <0>		"#define"				{ mkL PpDefine `andBegin` ppSC }
 <0>		"#undef"				{ mkL PpUndef }
 <0>		"#include"				{ mkL PpInclude }
+<0,ppSC>	"bitwise"				{ mkL KwBitwise }
 <0,ppSC>	"break"					{ mkL KwBreak }
 <0,ppSC>	"case"					{ mkL KwCase }
 <0,ppSC>	"const"					{ mkL KwConst }
@@ -161,6 +162,7 @@ tokens :-
 <0,ppSC>	"enum"					{ mkL KwEnum }
 <0,ppSC>	"extern"				{ mkL KwExtern }
 <0,ppSC>	"for"					{ mkL KwFor }
+<0,ppSC>	"force"					{ mkL KwForce }
 <0,ppSC>	"goto"					{ mkL KwGoto }
 <0,ppSC>	"if"					{ mkL KwIf }
 <0,ppSC>	"non_null"				{ mkL KwNonNull }
diff --git a/src/Language/Cimple/MapAst.hs b/src/Language/Cimple/MapAst.hs
index 96885d7..38ae2e2 100644
--- a/src/Language/Cimple/MapAst.hs
+++ b/src/Language/Cimple/MapAst.hs
@@ -327,6 +327,10 @@ instance MapAst itext otext (Node (Lexeme itext)) where
             Fix <$> (Union <$> recurse name <*> recurse members)
         MemberDecl decl bits ->
             Fix <$> (MemberDecl <$> recurse decl <*> recurse bits)
+        TyBitwise ty ->
+            Fix <$> (TyBitwise <$> recurse ty)
+        TyForce ty ->
+            Fix <$> (TyForce <$> recurse ty)
         TyConst ty ->
             Fix <$> (TyConst <$> recurse ty)
         TyPointer ty ->
diff --git a/src/Language/Cimple/Parser.y b/src/Language/Cimple/Parser.y
index 6443c39..c637878 100644
--- a/src/Language/Cimple/Parser.y
+++ b/src/Language/Cimple/Parser.y
@@ -43,6 +43,7 @@ import           Language.Cimple.Tokens      (LexemeClass (..))
     ID_STD_TYPE			{ L _ IdStdType			_ }
     ID_SUE_TYPE			{ L _ IdSueType			_ }
     ID_VAR			{ L _ IdVar			_ }
+    bitwise			{ L _ KwBitwise			_ }
     break			{ L _ KwBreak			_ }
     case			{ L _ KwCase			_ }
     const			{ L _ KwConst			_ }
@@ -53,6 +54,7 @@ import           Language.Cimple.Tokens      (LexemeClass (..))
     enum			{ L _ KwEnum			_ }
     extern			{ L _ KwExtern			_ }
     for				{ L _ KwFor			_ }
+    force			{ L _ KwForce			_ }
     GNU_PRINTF			{ L _ KwGnuPrintf		_ }
     goto			{ L _ KwGoto			_ }
     if				{ L _ KwIf			_ }
@@ -666,7 +668,9 @@ TypedefDecl
 
 QualType :: { NonTerm }
 QualType
-:	LeafType						{                                        $1 }
+:	bitwise ID_STD_TYPE					{ Fix (TyBitwise (Fix (TyStd $2))) }
+|	force LeafType						{ Fix (TyForce $2) }
+|	LeafType						{                                        $1 }
 |	LeafType '*'						{                              tyPointer $1 }
 |	LeafType '*' '*'					{          tyPointer          (tyPointer $1) }
 |	LeafType '*' '*' const					{ tyConst (tyPointer          (tyPointer $1)) }
diff --git a/src/Language/Cimple/Pretty.hs b/src/Language/Cimple/Pretty.hs
index 037e422..1fdd6d4 100644
--- a/src/Language/Cimple/Pretty.hs
+++ b/src/Language/Cimple/Pretty.hs
@@ -27,6 +27,7 @@ import           Text.PrettyPrint.ANSI.Leijen
 indentWidth :: Int
 indentWidth = 2
 
+kwBitwise       = dullgreen $ text "bitwise"
 kwBreak         = dullred   $ text "break"
 kwCase          = dullred   $ text "case"
 kwConst         = dullgreen $ text "const"
@@ -37,6 +38,7 @@ kwElse          = dullred   $ text "else"
 kwEnum          = dullgreen $ text "enum"
 kwExtern        = dullgreen $ text "extern"
 kwFor           = dullred   $ text "for"
+kwForce         = dullgreen $ text "force"
 kwGnuPrintf     = dullgreen $ text "GNU_PRINTF"
 kwGoto          = dullred   $ text "goto"
 kwIf            = dullred   $ text "if"
@@ -402,6 +404,8 @@ ppNode = foldFix go
     DeclSpecArray Nothing     -> text "[]"
     DeclSpecArray (Just dim)  -> brackets dim
 
+    TyBitwise     ty -> kwBitwise <+> ty
+    TyForce       ty -> kwForce <+> ty
     TyPointer     ty -> ty <> char '*'
     TyConst       ty -> ty <+> kwConst
     TyUserDefined l  -> dullgreen $ ppLexeme l
diff --git a/src/Language/Cimple/Tokens.hs b/src/Language/Cimple/Tokens.hs
index 1324080..da5b906 100644
--- a/src/Language/Cimple/Tokens.hs
+++ b/src/Language/Cimple/Tokens.hs
@@ -13,6 +13,7 @@ data LexemeClass
     | IdStdType
     | IdSueType
     | IdVar
+    | KwBitwise
     | KwBreak
     | KwCase
     | KwConst
@@ -23,6 +24,7 @@ data LexemeClass
     | KwEnum
     | KwExtern
     | KwFor
+    | KwForce
     | KwGnuPrintf
     | KwGoto
     | KwIf
diff --git a/src/Language/Cimple/TraverseAst.hs b/src/Language/Cimple/TraverseAst.hs
index 79dd74a..94346e5 100644
--- a/src/Language/Cimple/TraverseAst.hs
+++ b/src/Language/Cimple/TraverseAst.hs
@@ -426,6 +426,10 @@ instance TraverseAst text (Node (Lexeme text)) where
             _ <- recurse decl
             _ <- recurse bits
             pure ()
+        TyBitwise ty ->
+            recurse ty
+        TyForce ty ->
+            recurse ty
         TyConst ty ->
             recurse ty
         TyPointer ty ->