feat: Add support for owner qualifiers on pointers.

TokTok · Mar 7, 2024 · 8ee8eb7 · 8ee8eb7
1 parent c5e6d93
commit 8ee8eb7
Show file tree

Hide file tree

Showing 8 changed files with 19 additions and 2 deletions.
diff --git a/src/Language/Cimple/Ast.hs b/src/Language/Cimple/Ast.hs
@@ -105,6 +105,7 @@ data NodeF lexeme a
     | TyBitwise a
     | TyForce a
     | TyConst a
+    | TyOwner a
     | TyPointer a
     | TyStruct lexeme
     | TyFunc lexeme

diff --git a/src/Language/Cimple/Lexer.x b/src/Language/Cimple/Lexer.x
@@ -167,6 +167,7 @@ tokens :-
 <0,ppSC>	"if"					{ mkL KwIf }
 <0,ppSC>	"non_null"				{ mkL KwNonNull }
 <0,ppSC>	"nullable"				{ mkL KwNullable }
+<0,ppSC>	"owner"					{ mkL KwOwner }
 <0,ppSC>	"return"				{ mkL KwReturn }
 <0,ppSC>	"sizeof"				{ mkL KwSizeof }
 <0,ppSC>	"static"				{ mkL KwStatic }

diff --git a/src/Language/Cimple/MapAst.hs b/src/Language/Cimple/MapAst.hs
@@ -333,6 +333,8 @@ instance MapAst itext otext (Node (Lexeme itext)) where
             Fix <$> (TyForce <$> recurse ty)
         TyConst ty ->
             Fix <$> (TyConst <$> recurse ty)
+        TyOwner ty ->
+            Fix <$> (TyOwner <$> recurse ty)
         TyPointer ty ->
             Fix <$> (TyPointer <$> recurse ty)
         TyStruct name ->

diff --git a/src/Language/Cimple/Parser.y b/src/Language/Cimple/Parser.y
@@ -60,6 +60,7 @@ import           Language.Cimple.Tokens      (LexemeClass (..))
     if				{ L _ KwIf			_ }
     non_null			{ L _ KwNonNull			_ }
     nullable			{ L _ KwNullable		_ }
+    owner			{ L _ KwOwner			_ }
     return			{ L _ KwReturn			_ }
     sizeof			{ L _ KwSizeof			_ }
     static			{ L _ KwStatic			_ }
@@ -687,6 +688,11 @@ QualType
 |	const LeafType '*' const				{                     tyConst (tyPointer (tyConst $2)) }
 |	const LeafType '*' const '*'				{          tyPointer (tyConst (tyPointer (tyConst $2))) }
 |	const LeafType '*' const '*' const			{ tyConst (tyPointer (tyConst (tyPointer (tyConst $2)))) }
+|	LeafType '*'       owner				{            tyOwner          (tyPointer $1) }
+|	LeafType '*' const owner				{            tyOwner (tyConst (tyPointer $1)) }
+|	LeafType '*' '*' owner					{ tyOwner (tyPointer          (tyPointer $1)) }
+|	LeafType '*' owner '*'					{          tyPointer (tyOwner (tyPointer $1)) }
+|	LeafType '*' owner '*' owner				{ tyOwner (tyPointer (tyOwner (tyPointer $1))) }
 
 LeafType :: { NonTerm }
 LeafType
@@ -762,9 +768,10 @@ ConstDecl
 type Term = Lexeme Text
 type NonTerm = Node Term
 
-tyPointer, tyConst :: NonTerm -> NonTerm
+tyPointer, tyConst, tyOwner :: NonTerm -> NonTerm
 tyPointer = Fix . TyPointer
 tyConst = Fix . TyConst
+tyOwner = Fix . TyOwner
 
 lexwrap :: (Lexeme Text -> Alex a) -> Alex a
 lexwrap = (alexMonadScan >>=)

diff --git a/src/Language/Cimple/Pretty.hs b/src/Language/Cimple/Pretty.hs
@@ -44,6 +44,7 @@ kwGoto          = dullred   $ text "goto"
 kwIf            = dullred   $ text "if"
 kwNonNull       = dullgreen $ text "non_null"
 kwNullable      = dullgreen $ text "nullable"
+kwOwner         = dullgreen $ text "owner"
 kwReturn        = dullred   $ text "return"
 kwSizeof        = dullred   $ text "sizeof"
 kwStaticAssert  = dullred   $ text "static_assert"
@@ -153,7 +154,7 @@ ppCommentBody body = vsep . prefixStars . map (hcat . map ppWord . spaceWords) .
 
     spaceWords = \case
         (L c p s:ws) -> L c p (" "<>s):continue ws
-        [] -> []
+        []           -> []
       where
         continue [] = []
         continue (w@(L _ CmtEnd _):ws) = w:continue ws
@@ -408,6 +409,7 @@ ppNode = foldFix go
     TyForce       ty -> kwForce <+> ty
     TyPointer     ty -> ty <> char '*'
     TyConst       ty -> ty <+> kwConst
+    TyOwner       ty -> ty <+> kwOwner
     TyUserDefined l  -> dullgreen $ ppLexeme l
     TyStd         l  -> dullgreen $ ppLexeme l
     TyFunc        l  -> dullgreen $ ppLexeme l

diff --git a/src/Language/Cimple/Tokens.hs b/src/Language/Cimple/Tokens.hs
@@ -30,6 +30,7 @@ data LexemeClass
     | KwIf
     | KwNonNull
     | KwNullable
+    | KwOwner
     | KwReturn
     | KwSizeof
     | KwStatic

diff --git a/src/Language/Cimple/TraverseAst.hs b/src/Language/Cimple/TraverseAst.hs
@@ -432,6 +432,8 @@ instance TraverseAst text (Node (Lexeme text)) where
             recurse ty
         TyConst ty ->
             recurse ty
+        TyOwner ty ->
+            recurse ty
         TyPointer ty ->
             recurse ty
         TyStruct name ->

diff --git a/test/Language/CimpleSpec.hs b/test/Language/CimpleSpec.hs
@@ -41,6 +41,7 @@ sampleToken c = case c of
     KwIf                  -> "if"
     KwNonNull             -> "non_null"
     KwNullable            -> "nullable"
+    KwOwner               -> "owner"
     KwReturn              -> "return"
     KwSizeof              -> "sizeof"
     KwStatic              -> "static"