feat: Add support for comment-escaping code.

Writing `/*! code */` will be interpreted by Cimple, but ignored by all other compilers/parsers. This allows us to put some expressions in places where otherwise C can't.
TokTok · Jan 5, 2024 · 032d57b · 032d57b
1 parent 6088399
commit 032d57b
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 7 deletions.
diff --git a/src/Language/Cimple/Lexer.x b/src/Language/Cimple/Lexer.x
@@ -132,6 +132,8 @@ tokens :-
 <0>		[\ \n]+					;
 <0>		$white					{ mkE ErrorToken }
 <0>		"//!TOKSTYLE-"				{ mkL IgnStart `andBegin` ignoreSC }
+<0>		"/*!"					{ mkL CmtStartCode }
+<0>		"*/"					{ mkL CmtEnd }
 <0>		"/*"					{ mkL CmtStart `andBegin` cmtSC }
 <0>		"/**"					{ mkL CmtStartDoc `andBegin` cmtSC }
 <0>		"/** @{"				{ mkL CmtStartDocSection `andBegin` cmtSC }

diff --git a/src/Language/Cimple/MapAst.hs b/src/Language/Cimple/MapAst.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE InstanceSigs          #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -6,35 +7,36 @@
 {-# LANGUAGE Strict                #-}
 {-# LANGUAGE TypeFamilies          #-}
 module Language.Cimple.MapAst
-    ( mapAst
+    ( mapAst, mapFileAst
 
     , doFiles, doFile
     , doNodes, doNode
     , doComment, doComments
     , doLexemes, doLexeme
     , doText
 
-    , astActions
+    , AstActions, astActions
     , TextActions, textActions
     , IdentityActions, identityActions
     ) where
 
 import           Data.Fix              (Fix (..))
+import           GHC.Stack             (HasCallStack)
 import           Language.Cimple.Ast   (Comment, CommentF (..), Node,
                                         NodeF (..))
 import           Language.Cimple.Lexer (Lexeme (..))
 
 class MapAst itext otext a where
     type Mapped itext otext a
     mapFileAst
-        :: Applicative f
+        :: (Applicative f, HasCallStack)
         => AstActions f itext otext
         -> FilePath
         -> a
         -> f (Mapped itext otext a)
 
 mapAst
-    :: (MapAst itext otext    a, Applicative f)
+    :: (MapAst itext otext a, Applicative f, HasCallStack)
     => AstActions f itext otext -> a
     -> f    (Mapped itext otext    a)
 mapAst = flip mapFileAst "<stdin>"
@@ -86,7 +88,7 @@ identityActions = astActions pure
 instance MapAst itext otext (Lexeme itext) where
     type Mapped itext otext (Lexeme itext)
                           =  Lexeme otext
-    mapFileAst :: forall f . Applicative f
+    mapFileAst :: (Applicative f, HasCallStack)
                => AstActions f itext otext -> FilePath -> Lexeme itext -> f (Lexeme otext)
     mapFileAst AstActions{..} currentFile = doLexeme currentFile <*>
         \(L p c s) -> L p c <$> doText currentFile s
@@ -101,7 +103,7 @@ instance MapAst itext otext (Comment (Lexeme itext)) where
     type Mapped itext otext (Comment (Lexeme itext))
                           =  Comment (Lexeme otext)
     mapFileAst
-        :: forall f . Applicative f
+        :: forall f. (Applicative f, HasCallStack)
         => AstActions f itext otext
         -> FilePath
         ->    Comment (Lexeme itext)
@@ -177,7 +179,7 @@ instance MapAst itext otext (Node (Lexeme itext)) where
     type Mapped itext otext (Node (Lexeme itext))
                           =  Node (Lexeme otext)
     mapFileAst
-        :: forall f . Applicative f
+        :: forall f . (Applicative f, HasCallStack)
         => AstActions f itext otext
         -> FilePath
         ->    Node (Lexeme itext)

diff --git a/src/Language/Cimple/Parser.y b/src/Language/Cimple/Parser.y
@@ -126,6 +126,7 @@ import           Language.Cimple.Tokens (LexemeClass (..))
     '#undef'			{ L _ PpUndef			_ }
     '\n'			{ L _ PpNewline			_ }
     '/*'			{ L _ CmtStart			_ }
+    '/*!'			{ L _ CmtStartCode		_ }
     '/**'			{ L _ CmtStartDoc		_ }
     '/** @{'			{ L _ CmtStartDocSection	_ }
     '/** @} */'			{ L _ CmtEndDocSection		_ }
@@ -439,6 +440,7 @@ DeclSpecArray :: { NonTerm }
 DeclSpecArray
 :	'[' ']'							{ Fix $ DeclSpecArray Nothing }
 |	'[' Expr ']'						{ Fix $ DeclSpecArray (Just $2) }
+|	'[' '/*!' Expr '*/' ']'					{ Fix $ DeclSpecArray (Just $3) }
 
 InitialiserExpr :: { NonTerm }
 InitialiserExpr

diff --git a/src/Language/Cimple/Tokens.hs b/src/Language/Cimple/Tokens.hs
@@ -109,6 +109,7 @@ data LexemeClass
     | CmtPrefix
     | CmtIndent
     | CmtStart
+    | CmtStartCode
     | CmtStartBlock
     | CmtStartDoc
     | CmtStartDocSection