cimple 0.0.23 → 0.0.24
raw patch · 12 files changed
+75/−81 lines, 12 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Language.Cimple: KwNonNull :: LexemeClass
+ Language.Cimple: KwNonnull :: LexemeClass
+ Language.Cimple: TyNonnull :: a -> NodeF lexeme a
+ Language.Cimple: TyNullable :: a -> NodeF lexeme a
Files
- cimple.cabal +1/−1
- src/Language/Cimple/Ast.hs +2/−0
- src/Language/Cimple/DescribeAst.hs +1/−0
- src/Language/Cimple/Lexer.x +4/−2
- src/Language/Cimple/MapAst.hs +4/−0
- src/Language/Cimple/Parser.y +45/−60
- src/Language/Cimple/Pretty.hs +8/−6
- src/Language/Cimple/Tokens.hs +1/−1
- src/Language/Cimple/TraverseAst.hs +4/−0
- src/Language/Cimple/TreeParser.y +2/−0
- test/Language/Cimple/ParserSpec.hs +1/−9
- test/Language/CimpleSpec.hs +2/−2
cimple.cabal view
@@ -1,5 +1,5 @@ name: cimple-version: 0.0.23+version: 0.0.24 synopsis: Simple C-like programming language homepage: https://toktok.github.io/ license: GPL-3
src/Language/Cimple/Ast.hs view
@@ -106,6 +106,8 @@ | TyForce a | TyConst a | TyOwner a+ | TyNonnull a+ | TyNullable a | TyPointer a | TyStruct lexeme | TyFunc lexeme
src/Language/Cimple/DescribeAst.hs view
@@ -146,6 +146,7 @@ describeExpected options | wants ["break", "const", "continue", "ID_CONST", "VLA"] = "statement or declaration" | wants ["ID_FUNC_TYPE", "non_null", "static", "'#include'"] = "top-level declaration or definition"+ | options == ["ID_FUNC_TYPE", "ID_STD_TYPE", "ID_SUE_TYPE", "struct", "void"] = "top-level type specifier" | options == ["ID_STD_TYPE", "ID_SUE_TYPE", "struct", "void"] = "type specifier" | options == ["ID_STD_TYPE", "ID_SUE_TYPE", "bitwise", "const", "force", "struct", "void"] = "type specifier" | options == ["ID_CONST", "ID_VAR", "LIT_CHAR", "LIT_FALSE", "LIT_INTEGER", "'{'"] = "constant or literal"
src/Language/Cimple/Lexer.x view
@@ -116,6 +116,10 @@ -- Sodium constants. <0,ppSC> "crypto_"[a-z0-9_]+[A-Z][A-Z0-9_]* { mkL IdConst } +-- Clang nullability qualifiers.+<0,ppSC> "_Nonnull" { mkL KwNonnull }+<0,ppSC> "_Nullable" { mkL KwNullable }+ -- Standard C (ish). <ppSC> defined { mkL PpDefined } <ppSC> \"[^\"]*\" { mkL LitString }@@ -153,8 +157,6 @@ <0> "#include" { mkL PpInclude } <0,ppSC> "tox_"?"bitwise" { mkL KwBitwise } <0,ppSC> "tox_"?"force" { mkL KwForce }-<0,ppSC> "tox_"?"non_null" { mkL KwNonNull }-<0,ppSC> "tox_"?"nullable" { mkL KwNullable } <0,ppSC> "tox_"?"owner" { mkL KwOwner } <0,ppSC> "break" { mkL KwBreak } <0,ppSC> "case" { mkL KwCase }
src/Language/Cimple/MapAst.hs view
@@ -333,6 +333,10 @@ Fix <$> (TyForce <$> recurse ty) TyConst ty -> Fix <$> (TyConst <$> recurse ty)+ TyNonnull ty ->+ Fix <$> (TyNonnull <$> recurse ty)+ TyNullable ty ->+ Fix <$> (TyNullable <$> recurse ty) TyOwner ty -> Fix <$> (TyOwner <$> recurse ty) TyPointer ty ->
src/Language/Cimple/Parser.y view
@@ -58,7 +58,7 @@ GNU_PRINTF { L _ KwGnuPrintf _ } goto { L _ KwGoto _ } if { L _ KwIf _ }- non_null { L _ KwNonNull _ }+ nonnull { L _ KwNonnull _ } nullable { L _ KwNullable _ } owner { L _ KwOwner _ } return { L _ KwReturn _ }@@ -436,7 +436,7 @@ DeclStmt :: { NonTerm } DeclStmt : VarDeclStmt { $1 }-| VLA '(' QualType ',' ID_VAR ',' Expr ')' ';' { Fix $ VLA $3 $5 $7 }+| VLA '(' QualType(GlobalLeafType) ',' ID_VAR ',' Expr ')' ';' { Fix $ VLA $3 $5 $7 } VarDeclStmt :: { NonTerm } VarDeclStmt@@ -445,8 +445,7 @@ VarDecl :: { NonTerm } VarDecl-: QualType ID_VAR DeclSpecArrays { Fix $ VarDecl $1 $2 $3 }-| ID_FUNC_TYPE '*' ID_VAR DeclSpecArrays { Fix $ VarDecl (Fix $ TyPointer $ Fix $ TyFunc $1) $3 $4 }+: QualType(LocalLeafType) ID_VAR DeclSpecArrays { Fix $ VarDecl $1 $2 $3 } DeclSpecArrays :: { [NonTerm] } DeclSpecArrays@@ -456,7 +455,7 @@ DeclSpecArray :: { NonTerm } DeclSpecArray : '[' ']' { Fix $ DeclSpecArray Nothing }-| '[' Expr ']' { Fix $ DeclSpecArray (Just $2) }+| '[' Qual Expr ']' { Fix $ DeclSpecArray (Just ($2 $3)) } | '[' '/*!' Expr '*/' ']' { Fix $ DeclSpecArray (Just $3) } InitialiserExpr :: { NonTerm }@@ -487,9 +486,9 @@ PreprocSafeExpr(x) : LiteralExpr { $1 } | '(' x ')' { Fix $ ParenExpr $2 }-| '(' QualType ')' x %prec CAST { Fix $ CastExpr $2 $4 }+| '(' QualType(LocalLeafType) ')' x %prec CAST { Fix $ CastExpr $2 $4 } | sizeof '(' Expr ')' { Fix $ SizeofExpr $3 }-| sizeof '(' QualType ')' { Fix $ SizeofType $3 }+| sizeof '(' QualType(LocalLeafType) ')' { Fix $ SizeofType $3 } ConstExpr :: { NonTerm } ConstExpr@@ -554,7 +553,7 @@ -- Allow `(Type){0}` to set struct values to all-zero. CompoundLiteral :: { NonTerm } CompoundLiteral-: '(' QualType ')' '{' ZeroInitExpr '}' { Fix $ CompoundLiteral $2 $5 }+: '(' QualType(LocalLeafType) ')' '{' ZeroInitExpr '}' { Fix $ CompoundLiteral $2 $5 } ZeroInitExpr :: { NonTerm } ZeroInitExpr@@ -664,71 +663,57 @@ TypedefDecl :: { NonTerm } TypedefDecl-: typedef QualType ID_SUE_TYPE ';' { Fix $ Typedef $2 $3 }+: typedef QualType(GlobalLeafType) ID_SUE_TYPE ';' { Fix $ Typedef $2 $3 } | typedef FunctionPrototype(ID_FUNC_TYPE) ';' { Fix $ TypedefFunction $2 } | struct ID_SUE_TYPE ';' { Fix $ Typedef (Fix (TyStruct $2)) $2 } -QualType :: { NonTerm }-QualType+QualType(leafType) : 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)) }-| LeafType '*' const { tyConst (tyPointer $1) }-| LeafType '*' const '*' { tyPointer (tyConst (tyPointer $1)) }-| LeafType '*' const '*' const { tyConst (tyPointer (tyConst (tyPointer $1))) }-| LeafType const { tyConst $1 }-| LeafType const '*' { tyPointer (tyConst $1) }-| LeafType const '*' const { tyConst (tyPointer (tyConst $1)) }-| LeafType const '*' const '*' { tyPointer (tyConst (tyPointer (tyConst $1))) }-| LeafType const '*' const '*' const { tyConst (tyPointer (tyConst (tyPointer (tyConst $1)))) }-| const LeafType { tyConst $2 }-| const LeafType '*' { tyPointer (tyConst $2) }-| 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))) }+| force leafType { Fix (TyForce $2) }+| leafType ConstQual { ($2 $1) }+| leafType ConstQual '*' Qual { $4 (tyPointer ($2 $1)) }+| leafType ConstQual '*' Qual '*' Qual { $6 (tyPointer ($4 (tyPointer ($2 $1)))) }+| const leafType { (tyConst $2) }+| const leafType '*' Qual { $4 (tyPointer (tyConst $2)) }+| const leafType '*' Qual '*' Qual { $6 (tyPointer ($4 (tyPointer (tyConst $2)))) } -LeafType :: { NonTerm }-LeafType+ConstQual :: { NonTerm -> NonTerm }+ConstQual+: { id }+| const { tyConst }++Qual :: { NonTerm -> NonTerm }+Qual+: { id }+| const { tyConst }+| nonnull { tyNonnull }+| nullable { tyNullable }+| nonnull const { tyConst . tyNonnull }+| nullable const { tyConst . tyNullable }+| owner { tyOwner }++GlobalLeafType :: { NonTerm }+GlobalLeafType : struct ID_SUE_TYPE { Fix $ TyStruct $2 } | void { Fix $ TyStd $1 } | ID_STD_TYPE { Fix $ TyStd $1 } | ID_SUE_TYPE { Fix $ TyUserDefined $1 } +LocalLeafType :: { NonTerm }+LocalLeafType+: GlobalLeafType { $1 }+| ID_FUNC_TYPE { Fix $ TyFunc $1 }+ FunctionDecl :: { NonTerm } FunctionDecl : FunctionDeclarator { $1 Global } | static FunctionDeclarator { $2 Static }-| NonNull FunctionDeclarator { $1 $ $2 Global }-| NonNull static FunctionDeclarator { $1 $ $3 Static }-| NonNull Attrs FunctionDeclarator { $1 . $2 . $3 $ Global }+| Attrs FunctionDeclarator { $1 $ $2 Global } Attrs :: { NonTerm -> NonTerm } Attrs : GNU_PRINTF '(' LIT_INTEGER ',' LIT_INTEGER ')' { Fix . AttrPrintf $3 $5 } -NonNull :: { NonTerm -> NonTerm }-NonNull-: non_null '(' ')' { Fix . NonNull [] [] }-| nullable '(' Ints ')' { Fix . NonNull [] $3 }-| non_null '(' Ints ')' nullable '(' Ints ')' { Fix . NonNull $3 $7 }--Ints :: { [Term] }-Ints-: IntList { reverse $1 }--IntList :: { [Term] }-IntList-: LIT_INTEGER { [$1] }-| IntList ',' LIT_INTEGER { $3 : $1 }- FunctionDeclarator :: { Scope -> NonTerm } FunctionDeclarator : FunctionPrototype(ID_VAR) ';' { \s -> Fix $ FunctionDecl s $1 }@@ -740,7 +725,7 @@ : ID_FUNC_TYPE ID_VAR { Fix $ CallbackDecl $1 $2 } FunctionPrototype(id)-: QualType id FunctionParamList { Fix $ FunctionPrototype $1 $2 $3 }+: QualType(GlobalLeafType) id FunctionParamList { Fix $ FunctionPrototype $1 $2 $3 } | ID_FUNC_TYPE '*' id FunctionParamList { Fix $ FunctionPrototype (Fix $ TyPointer $ Fix $ TyFunc $1) $3 $4 } FunctionParamList :: { [NonTerm] }@@ -758,14 +743,12 @@ FunctionParam :: { NonTerm } FunctionParam : VarDecl { $1 }-| non_null '(' ')' VarDecl { Fix $ NonNullParam $4 }-| nullable '(' ')' VarDecl { Fix $ NullableParam $4 } ConstDecl :: { NonTerm } ConstDecl-: extern const LeafType ID_VAR ';' { Fix $ ConstDecl $3 $4 }-| const LeafType ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Global $2 $3 $5 }-| static const LeafType ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Static $3 $4 $6 }+: extern const GlobalLeafType ID_VAR ';' { Fix $ ConstDecl $3 $4 }+| const GlobalLeafType ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Global $2 $3 $5 }+| static const GlobalLeafType ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Static $3 $4 $6 } { type Term = Lexeme Text@@ -775,6 +758,8 @@ tyPointer = Fix . TyPointer tyConst = Fix . TyConst tyOwner = Fix . TyOwner+tyNullable = Fix . TyNullable+tyNonnull = Fix . TyNonnull lexwrap :: (Lexeme Text -> Alex a) -> Alex a lexwrap = (alexMonadScan >>=)
src/Language/Cimple/Pretty.hs view
@@ -44,8 +44,8 @@ kwGnuPrintf = dullgreen $ pretty "GNU_PRINTF" kwGoto = dullred $ pretty "goto" kwIf = dullred $ pretty "if"-kwNonNull = dullgreen $ pretty "non_null"-kwNullable = dullgreen $ pretty "nullable"+kwNonnull = dullgreen $ pretty "_Nonnull"+kwNullable = dullgreen $ pretty "_Nullable" kwOwner = dullgreen $ pretty "owner" kwReturn = dullred $ pretty "return" kwSizeof = dullred $ pretty "sizeof"@@ -417,6 +417,8 @@ TyForce ty -> kwForce <+> ty TyPointer ty -> ty <> pretty '*' TyConst ty -> ty <+> kwConst+ TyNonnull ty -> ty <+> kwNonnull+ TyNullable ty -> ty <+> kwNullable TyOwner ty -> ty <+> kwOwner TyUserDefined l -> dullgreen $ ppLexeme l TyStd l -> dullgreen $ ppLexeme l@@ -541,16 +543,16 @@ ) <$$> rbrace <+> dullgreen (ppLexeme ty) <> semi NonNull [] [] f ->- kwNonNull <> pretty "()" <$$> f+ kwNonnull <> pretty "()" <$$> f NonNull nonnull [] f ->- kwNonNull <> ppIntList nonnull <$$> f+ kwNonnull <> ppIntList nonnull <$$> f NonNull [] nullable f -> kwNullable <> ppIntList nullable <$$> f NonNull nonnull nullable f ->- kwNonNull <> ppIntList nonnull <+> kwNullable <> ppIntList nullable <$$> f+ kwNonnull <> ppIntList nonnull <+> kwNullable <> ppIntList nullable <$$> f NonNullParam p ->- kwNonNull <> pretty "()" <+> p+ kwNonnull <> pretty "()" <+> p NullableParam p -> kwNullable <> pretty "()" <+> p
src/Language/Cimple/Tokens.hs view
@@ -28,7 +28,7 @@ | KwGnuPrintf | KwGoto | KwIf- | KwNonNull+ | KwNonnull | KwNullable | KwOwner | KwReturn
src/Language/Cimple/TraverseAst.hs view
@@ -432,6 +432,10 @@ recurse ty TyConst ty -> recurse ty+ TyNonnull ty ->+ recurse ty+ TyNullable ty ->+ recurse ty TyOwner ty -> recurse ty TyPointer ty ->
src/Language/Cimple/TreeParser.y view
@@ -121,6 +121,7 @@ functionPrototype { Fix (FunctionPrototype{}) } ellipsis { Fix (Ellipsis) } nonNull { Fix (NonNull{}) }+ attrPrintf { Fix (AttrPrintf{}) } -- Constants constDecl { Fix (ConstDecl{}) } constDefn { Fix (ConstDefn{}) }@@ -195,6 +196,7 @@ : functionDecl { $1 } | functionDefn { $1 } | nonNull { $1 }+| attrPrintf { $1 } | aggregateDecl { $1 } | struct { $1 } | typedef { $1 }
test/Language/Cimple/ParserSpec.hs view
@@ -22,16 +22,8 @@ let ast = parseText "int a(void) { return 3; }" ast `shouldSatisfy` isRight1 - it "should parse non_null annotations" $ do- let ast = parseText "non_null() int a(char *p);"- ast `shouldSatisfy` isRight1-- it "should parse non_null and nullable annotations" $ do- let ast = parseText "non_null(2) nullable(1) int a(char *p, int *q);"- ast `shouldSatisfy` isRight1- it "should parse per-param non_null and nullable annotations" $ do- let ast = parseText "int a(non_null() char *p, non_null() int *q);"+ let ast = parseText "int a(char *_Nonnull p, int *_Nullable q);" ast `shouldSatisfy` isRight1 it "should parse a type declaration" $ do
test/Language/CimpleSpec.hs view
@@ -39,8 +39,8 @@ KwGnuPrintf -> "gnu_printf" KwGoto -> "goto" KwIf -> "if"- KwNonNull -> "non_null"- KwNullable -> "nullable"+ KwNonnull -> "_Nonnull"+ KwNullable -> "_Nullable" KwOwner -> "owner" KwReturn -> "return" KwSizeof -> "sizeof"