packages feed

cimple 0.0.19 → 0.0.20

raw patch · 16 files changed

+520/−67 lines, 16 filesdep +QuickCheckdep +extradep +file-embeddep −recursion-schemesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, extra, file-embed

Dependencies removed: recursion-schemes

API changes (from Hackage documentation)

- Language.Cimple: CmtPrefix :: LexemeClass
+ Language.Cimple: DocCode :: lexeme -> [a] -> lexeme -> CommentF lexeme a
+ Language.Cimple: KwBitwise :: LexemeClass
+ Language.Cimple: KwForce :: LexemeClass
+ Language.Cimple: TyBitwise :: a -> NodeF lexeme a
+ Language.Cimple: TyForce :: a -> NodeF lexeme a
+ Language.Cimple: source :: Maybe ByteString

Files

cimple.cabal view
@@ -1,5 +1,5 @@ name:          cimple-version:       0.0.19+version:       0.0.20 synopsis:      Simple C-like programming language homepage:      https://toktok.github.io/ license:       GPL-3@@ -55,10 +55,10 @@     , bytestring     , containers     , data-fix+    , file-embed     , filepath     , monad-parallel     , mtl-    , recursion-schemes     , split     , text     , transformers-compat@@ -111,17 +111,21 @@   hs-source-dirs:     test   main-is:            testsuite.hs   other-modules:+    Language.CimpleSpec     Language.Cimple.AstSpec+    Language.Cimple.DescribeAstSpec     Language.Cimple.ParserSpec     Language.Cimple.PrettySpec    ghc-options:        -Wall -Wno-unused-imports   build-tool-depends: hspec-discover:hspec-discover   build-depends:-      ansi-wl-pprint+      QuickCheck+    , ansi-wl-pprint     , base                 <5     , cimple     , data-fix+    , extra     , hspec     , text     , transformers-compat
src/Language/Cimple/Ast.hs view
@@ -102,6 +102,8 @@     | Struct lexeme [a]     | Union lexeme [a]     | MemberDecl a (Maybe lexeme)+    | TyBitwise a+    | TyForce a     | TyConst a     | TyPointer a     | TyStruct lexeme@@ -147,6 +149,7 @@      | DocParagraph [a]     | DocLine [a]+    | DocCode lexeme [a] lexeme     | DocList [a]     | DocULItem [a] [a]     | DocOLItem lexeme [a]
src/Language/Cimple/CommentParser.y view
@@ -38,11 +38,14 @@     '@return'			{ L _ CmtCommand "@return"	}     '@retval'			{ L _ CmtCommand "@retval"	}     '@see'			{ L _ CmtCommand "@see"		}+    '@code'			{ L _ CmtCode	 "@code"	}+    '@endcode'			{ L _ CmtCode	 "@endcode"	}      ' '				{ L _ CmtIndent		" "	}     'INDENT1'			{ L _ CmtIndent		"   "	}     'INDENT2'			{ L _ CmtIndent		"    " 	}     'INDENT3'			{ L _ CmtIndent		"     "	}+    'INDENT'			{ L _ CmtIndent			_ }      '('				{ L _ PctLParen			_ }     ')'				{ L _ PctRParen			_ }@@ -143,7 +146,27 @@ |	'@implements' CMT_WORD					{ Fix $ DocImplements $2 } |	'@extends' CMT_WORD					{ Fix $ DocExtends $2 } |	'@private'						{ Fix DocPrivate }+|	Code							{ $1 } +Code :: { NonTerm }+Code+:	'@code' CodeWords '@endcode'				{ Fix $ DocCode $1 (reverse $2) $3 }++CodeWords :: { [NonTerm] }+CodeWords+:	CodeWord						{ [$1] }+|	CodeWords CodeWord					{ $2 : $1 }++CodeWord :: { NonTerm }+CodeWord+:	'\n'							{ Fix $ DocWord $1 }+|	' '							{ Fix $ DocWord $1 }+|	'INDENT1'						{ Fix $ DocWord $1 }+|	'INDENT2'						{ Fix $ DocWord $1 }+|	'INDENT3'						{ Fix $ DocWord $1 }+|	'INDENT'						{ Fix $ DocWord $1 }+|	CMT_CODE						{ Fix $ DocWord $1 }+ BulletListItem :: { NonTerm } BulletListItem :	'-' Words '\n' BulletICont				{ Fix $ DocULItem $2 $4 }@@ -232,7 +255,7 @@  failAt :: Lexeme Text -> String -> ParseResult a failAt n msg =-    fail $ Text.unpack (sloc "" n) <> ": unexpected " <> describeLexeme n <> msg+    fail $ Text.unpack (sloc "" n) <> ": unexpected in comment: " <> describeLexeme n <> msg  parseError :: ([Lexeme Text], [String]) -> ParseResult a parseError ([], options)  = fail $ " end of comment; expected one of " <> show options
src/Language/Cimple/DescribeAst.hs view
@@ -5,14 +5,19 @@     ( HasLocation (..)     , describeLexeme     , describeNode+    , parseError     ) where  import           Data.Fix                (Fix (..), foldFix)+import           Data.List               (isPrefixOf, (\\))+import qualified Data.List               as List import           Data.Text               (Text) import qualified Data.Text               as Text import           Language.Cimple.Ast     (Node, NodeF (..)) import qualified Language.Cimple.Flatten as Flatten-import           Language.Cimple.Lexer   (Lexeme, lexemeLine)+import           Language.Cimple.Lexer   (Alex, AlexPosn (..), Lexeme (..),+                                          alexError, lexemeLine)+import           Language.Cimple.Tokens  (LexemeClass (..))   class HasLocation a where@@ -38,5 +43,137 @@     ellipsis :: String     ellipsis = "..." +describeLexemeClass :: LexemeClass -> Maybe String+describeLexemeClass = d+  where+    d IdConst               = Just "constant name"+    d IdFuncType            = Just "function type name"+    d IdStdType             = Just "standard type name"+    d IdSueType             = Just "type name"+    d IdVar                 = Just "variable name"+    d LitChar               = Just "character literal"+    d LitInteger            = Just "integer literal"+    d LitString             = Just "string literal"+    d LitSysInclude         = Just "system include"+    d PctAmpersand          = Just "address-of or bitwise-and operator"+    d PctAmpersandAmpersand = Just "logical-and operator"+    d PctAmpersandEq        = Just "bitwise-and-assign operator"+    d PctArrow              = Just "pointer-member-access operator"+    d PctAsterisk           = Just "pointer-type, dereference, or multiply operator"+    d PctAsteriskEq         = Just "multiply-assign operator"+    d PctCaret              = Just "bitwise-xor operator"+    d PctCaretEq            = Just "xor-assign operator"+    d PctColon              = Just "ternary operator"+    d PctComma              = Just "comma"+    d PctEllipsis           = Just "ellipsis"+    d PctEMark              = Just "logical not operator"+    d PctEMarkEq            = Just "not-equals operator"+    d PctEq                 = Just "assignment operator"+    d PctEqEq               = Just "equals operator"+    d PctGreater            = Just "greater-than operator"+    d PctGreaterEq          = Just "greater-or-equals operator"+    d PctGreaterGreater     = Just "right-shift operator"+    d PctGreaterGreaterEq   = Just "right-shift-assign operator"+    d PctLBrace             = Just "left brace"+    d PctLBrack             = Just "left square bracket"+    d PctLess               = Just "less-than operator"+    d PctLessEq             = Just "less-or-equals operator"+    d PctLessLess           = Just "left-shift operator"+    d PctLessLessEq         = Just "left-shift-assign operator"+    d PctLParen             = Just "left parenthesis"+    d PctMinus              = Just "minus operator"+    d PctMinusEq            = Just "minus-assign operator"+    d PctMinusMinus         = Just "decrement operator"+    d PctPeriod             = Just "member access operator"+    d PctPercent            = Just "modulus operator"+    d PctPercentEq          = Just "modulus-assign operator"+    d PctPipe               = Just "bitwise-or operator"+    d PctPipeEq             = Just "bitwise-or-assign operator"+    d PctPipePipe           = Just "logical-or operator"+    d PctPlus               = Just "addition operator"+    d PctPlusEq             = Just "add-assign operator"+    d PctPlusPlus           = Just "increment operator"+    d PctQMark              = Just "ternary operator"+    d PctRBrace             = Just "right brace"+    d PctRBrack             = Just "right square bracket"+    d PctRParen             = Just "right parenthesis"+    d PctSemicolon          = Just "end of statement semicolon"+    d PctSlash              = Just "division operator"+    d PctSlashEq            = Just "divide-assign operator"+    d PctTilde              = Just "bitwise-not operator"+    d PpDefine              = Just "preprocessor define"+    d PpDefined             = Just "preprocessor defined"+    d PpElif                = Just "preprocessor elif"+    d PpElse                = Just "preprocessor else"+    d PpEndif               = Just "preprocessor endif"+    d PpIf                  = Just "preprocessor if"+    d PpIfdef               = Just "preprocessor ifdef"+    d PpIfndef              = Just "preprocessor ifndef"+    d PpInclude             = Just "preprocessor include"+    d PpNewline             = Just "newline"+    d PpUndef               = Just "preprocessor undef"+    d CmtBlock              = Just "block comment"+    d CmtCommand            = Just "doxygen command"+    d CmtAttr               = Just "parameter attribute"+    d CmtEndDocSection      = Just "doxygen end-of-section"+    d CmtIndent             = Just "indented comment"+    d CmtStart              = Just "start of comment"+    d CmtStartCode          = Just "escaped comment"+    d CmtStartBlock         = Just "block comment"+    d CmtStartDoc           = Just "doxygen comment"+    d CmtStartDocSection    = Just "doxygen start-of-section"+    d CmtSpdxCopyright      = Just "SPDX Copyright"+    d CmtSpdxLicense        = Just "SPDX License"+    d CmtCode               = Just "code comment"+    d CmtWord               = Just "comment word"+    d CmtRef                = Just "comment reference"+    d CmtEnd                = Just "end of comment"+    d IgnStart              = Just "tokstyle ignore start"+    d IgnBody               = Just "tokstyle ignored code"+    d IgnEnd                = Just "tokstyle ignore end"++    d ErrorToken            = Just "lexical error"+    d Eof                   = Just "end-of-file"+    d _                     = Nothing+ describeLexeme :: Show a => Lexeme a -> String-describeLexeme = show+describeLexeme (L _ c s) = maybe "" (<> ": ") (describeLexemeClass c) <> show s++describeExpected :: [String] -> String+describeExpected [] = "end of file"+describeExpected ["ID_VAR"] = "variable name"+describeExpected [option] = option+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_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"+    | ["ID_FUNC_TYPE", "ID_STD_TYPE", "ID_SUE_TYPE", "ID_VAR"] `isPrefixOf` options = "type specifier or variable name"+    | ["ID_FUNC_TYPE", "ID_STD_TYPE", "ID_SUE_TYPE", "bitwise", "const"] `isPrefixOf` options = "type specifier"+    | ["ID_CONST", "sizeof", "LIT_CHAR", "LIT_FALSE", "LIT_TRUE", "LIT_INTEGER"] `isPrefixOf` options = "constant expression"+    | ["ID_CONST", "ID_SUE_TYPE", "'/*'"] `isPrefixOf` options = "enumerator, type name, or comment"+    | wants ["'defined'"] = "preprocessor constant expression"+    | wants ["'&'", "'&&'", "'*'", "'=='", "';'"] = "operator or end of statement"+    | wants ["'&'", "'&&'", "'*'", "'^'", "'!='"] = "operator"+    | wants ["ID_CONST", "ID_VAR", "sizeof", "LIT_CHAR", "'--'", "'&'", "'*'"] = "expression"+    | ["ID_CONST", "ID_STD_TYPE", "ID_SUE_TYPE", "ID_VAR", "const", "sizeof"] `isPrefixOf` options = "expression or type specifier"+    | ["ID_CONST", "ID_STD_TYPE", "ID_SUE_TYPE", "const", "sizeof"] `isPrefixOf` options = "constant expression or type specifier"+    | ["'&='", "'->'", "'*='"] `isPrefixOf` options = "assignment or member/array access"+    | wants ["CMT_WORD"] = "comment contents"++    | length options == 2 = commaOr options+    | otherwise           = "one of " <> commaOr options+  where+    wants xs = null (xs \\ options)++commaOr :: [String] -> String+commaOr = go . reverse+  where+    go []     = ""+    go (x:xs) = List.intercalate ", " (reverse xs) <> " or " <> x++parseError :: Show text => (Lexeme text, [String]) -> Alex a+parseError (l@(L (AlexPn _ line col) _ _), options) =+    alexError $ ":" <> show line <> ":" <> show col <> ": Parse error near " <> describeLexeme l+        <> "; expected " <> describeExpected options
src/Language/Cimple/Flatten.hs view
@@ -68,6 +68,7 @@     gconcatsFlatten (Fix (DocExtends x)) = gconcatsFlatten x     gconcatsFlatten (Fix (DocImplements x)) = gconcatsFlatten x     gconcatsFlatten (Fix (DocLine x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocCode b x e)) = concat [gconcatsFlatten b, gconcatsFlatten x, gconcatsFlatten e]     gconcatsFlatten (Fix (DocList x)) = gconcatsFlatten x     gconcatsFlatten (Fix (DocLParen x)) = gconcatsFlatten x     gconcatsFlatten (Fix (DocOLItem i x)) = i : gconcatsFlatten x
src/Language/Cimple/Lexer.x view
@@ -151,6 +151,7 @@ <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 @@ <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 }@@ -192,12 +194,15 @@ <0,ppSC>	"false"					{ mkL LitFalse } <0,ppSC>	"true"					{ mkL LitTrue } <0,ppSC>	"__func__"				{ mkL IdVar }+<0,ppSC>	"nullptr"				{ mkL IdConst } <0,ppSC>	"__"[a-zA-Z]+"__"?			{ mkL IdConst } <0,ppSC>	[A-Z][A-Z0-9_]{1,2}			{ mkL IdSueType } <0,ppSC>	_*[A-Z][A-Z0-9_]*			{ mkL IdConst } <0,ppSC>	[A-Z][A-Za-z0-9_]*[a-z][A-Za-z0-9_]*	{ mkL IdSueType }+<0,ppSC>	"cmp_"[a-z][a-z0-9_]*_[stu]		{ mkL IdSueType } <0,ppSC>	[a-z][a-z0-9_]*_t			{ mkL IdStdType } <0,ppSC>	[a-z][a-z0-9_]*_cb			{ mkL IdFuncType }+<0,ppSC>	"cmp_"("reader"|"writer"|"skipper")	{ mkL IdFuncType } <0,ppSC>	[a-z][A-Za-z0-9_]*			{ mkL IdVar } <0,ppSC,cmtSC>	[0-9]+[LU]*				{ mkL LitInteger } <0,ppSC,cmtSC>	[0-9]+"."[0-9]+[Ff]?			{ mkL LitInteger }@@ -254,14 +259,15 @@ <cmtSC>		"SPDX-License-Identifier:"		{ mkL CmtSpdxLicense } <cmtSC>		"GPL-3.0-or-later"			{ mkL CmtWord } <cmtSC>		"TODO("[^\)]+"):"			{ mkL CmtWord }-<cmtSC>		[A-Z][A-Za-z]+"::"[a-z_]+		{ mkL CmtWord }-<cmtSC>		"E.g."					{ mkL CmtWord }-<cmtSC>		"e.g."					{ mkL CmtWord }+<cmtSC>		[Ee]".g."				{ mkL CmtWord } <cmtSC>		"etc."					{ mkL CmtWord }-<cmtSC>		"I.e."					{ mkL CmtWord }-<cmtSC>		"i.e."					{ mkL CmtWord }+<cmtSC>		[Ii]".e."				{ mkL CmtWord } <cmtSC>		[0-2][0-9](":"[0-5][0-9]){2}"."[0-9]{3}	{ mkL CmtWord }-<cmtSC>		"v"?[0-9]"."[0-9]"."[0-9]		{ mkL CmtWord }+<cmtSC>		"v"?[0-9]+("."[0-9]+)+			{ mkL CmtWord }+<cmtSC>		[A-Z][A-Za-z]+"::"[a-z_]+		{ mkL CmtWord }+<cmtSC>		([a-z]+"/")+[A-Za-z]+("."[a-z_]+)+	{ mkL CmtWord }+<cmtSC>		[a-z]+("."[a-z_]+)+			{ mkL CmtWord }+<cmtSC>		[a-z]+("-"[a-z_]+)+			{ mkL CmtWord } <cmtSC>		"@code"					{ mkL CmtCode `andBegin` codeSC } <cmtSC>		"<code>"				{ mkL CmtCode `andBegin` codeSC } <cmtSC>		"["[^\]]+"]"				{ mkL CmtAttr }@@ -269,13 +275,15 @@ <cmtSC>		[@\\][a-z]+				{ mkL CmtCommand } <cmtSC>		"*"[A-Za-z][A-Za-z0-9_']*"*"		{ mkL CmtWord } <cmtSC>		"#"[A-Za-z][A-Za-z0-9_]*		{ mkL CmtRef }-<cmtSC>		[A-Za-z][A-Za-z0-9_']*			{ mkL CmtWord }+<cmtSC>		"_"*[A-Za-z][A-Za-z0-9_']*		{ mkL CmtWord } <cmtSC>		"#"[0-9]+				{ mkL CmtWord } <cmtSC>		"http://"[^\ ]+				{ mkL CmtWord } <cmtSC>		[0-9]+"%"				{ mkL LitInteger } <cmtSC>		"-1"					{ mkL LitInteger } <cmtSC>		"`"([^`]|"\`")+"`"			{ mkL CmtCode } <cmtSC>		"${"([^\}])+"}"				{ mkL CmtCode }+<cmtSC>		"-"+					{ mkL CmtWord }+<cmtSC>		[&\|]+					{ mkL CmtWord } <cmtSC>		"–"					{ mkL CmtWord } <cmtSC>		"*/"					{ mkL CmtEnd `andBegin` 0 } <cmtSC>		\n					{ mkL PpNewline `andBegin` cmtNewlineSC }
src/Language/Cimple/MapAst.hs view
@@ -142,6 +142,8 @@             Fix <$> (DocParagraph <$> recurse docs)         DocLine docs ->             Fix <$> (DocLine <$> recurse docs)+        DocCode begin docs end ->+            Fix <$> (DocCode <$> recurse begin <*> recurse docs <*> recurse end)         DocList docs ->             Fix <$> (DocList <$> recurse docs)         DocOLItem docs sublist ->@@ -325,6 +327,10 @@             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 ->
src/Language/Cimple/Parser.y view
@@ -1,21 +1,28 @@ {+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-} module Language.Cimple.Parser     ( parseExpr     , parseStmt     , parseTranslationUnit+    , source     ) where -import           Data.Fix               (Fix (..))-import           Data.Text              (Text)-import qualified Data.Text              as Text-import           Language.Cimple.Ast    (AssignOp (..), BinaryOp (..),-                                         CommentStyle (..), LiteralType (..),-                                         Node, NodeF (..), Scope (..),-                                         UnaryOp (..))-import           Language.Cimple.Lexer  (Alex, AlexPosn (..), Lexeme (..),-                                         alexError, alexMonadScan)-import           Language.Cimple.Tokens (LexemeClass (..))+import qualified Data.ByteString             as BS+import           Data.FileEmbed              (embedFile)+import           Data.Fix                    (Fix (..))+import           Data.Text                   (Text)+import qualified Data.Text                   as Text+import           Language.Cimple.Ast         (AssignOp (..), BinaryOp (..),+                                              CommentStyle (..),+                                              LiteralType (..), Node,+                                              NodeF (..), Scope (..),+                                              UnaryOp (..))+import           Language.Cimple.DescribeAst (parseError)+import           Language.Cimple.Lexer       (Alex, AlexPosn (..), Lexeme (..),+                                              alexError, alexMonadScan)+import           Language.Cimple.Tokens      (LexemeClass (..)) }  -- Conflict between (static) FunctionDecl and (static) ConstDecl.@@ -36,6 +43,7 @@     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			_ }@@ -46,6 +54,7 @@     enum			{ L _ KwEnum			_ }     extern			{ L _ KwExtern			_ }     for				{ L _ KwFor			_ }+    force			{ L _ KwForce			_ }     GNU_PRINTF			{ L _ KwGnuPrintf		_ }     goto			{ L _ KwGoto			_ }     if				{ L _ KwIf			_ }@@ -131,7 +140,6 @@     '/** @{'			{ L _ CmtStartDocSection	_ }     '/** @} */'			{ L _ CmtEndDocSection		_ }     '/***'			{ L _ CmtStartBlock		_ }-    ' * '			{ L _ CmtPrefix			_ }     ' '				{ L _ CmtIndent			_ }     '*/'			{ L _ CmtEnd			_ }     'Copyright'			{ L _ CmtSpdxCopyright		_ }@@ -233,7 +241,6 @@ CommentToken :	CommentWord						{ $1 } |	'\n'							{ $1 }-|	' * '							{ $1 } |	' '							{ $1 }  CommentWords :: { [Term] }@@ -279,11 +286,11 @@ |	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 }+:	'#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 }  PreprocIf(decls)-:	'#if' PreprocConstExpr '\n' decls PreprocElif(decls) '#endif'	{ Fix $ PreprocIf $2 (reverse $4) $5 }+:	'#if' PreprocConstExpr '\n' decls PreprocElif(decls) Endif	{ Fix $ PreprocIf $2 (reverse $4) $5 }  PreprocElif(decls) :	PreprocElse(decls)					{ $1 }@@ -293,6 +300,10 @@ :								{ Fix $ PreprocElse [] } |	'#else' decls						{ Fix $ PreprocElse (reverse $2) } +Endif :: { [Term] }+Endif+:	'#endif' Comment					{ [$1] }+ PreprocInclude :: { NonTerm } PreprocInclude :	'#include' LIT_STRING					{ Fix $ PreprocInclude $2 }@@ -340,7 +351,7 @@ 	'#endif' 	ToplevelDecls 	'#ifdef' ID_CONST-	'}'+	'}' Comment 	'#endif'						{% externC $2 $4 (reverse $7) $9 }  Stmts :: { [NonTerm] }@@ -355,7 +366,8 @@ |	PreprocDefine Stmts PreprocUndef			{ Fix $ PreprocScopedDefine $1 (reverse $2) $3 } |	DeclStmt						{ $1 } |	CompoundStmt						{ $1 }-|	IfStmt							{ $1 }+|	IfStmt(ReturnStmt)					{ $1 }+|	IfStmt(CompoundStmt)					{ $1 } |	ForStmt							{ $1 } |	WhileStmt						{ $1 } |	DoWhileStmt						{ $1 }@@ -367,17 +379,20 @@ |	goto ID_CONST ';'					{ Fix $ Goto $2 } |	ID_CONST ':' Stmt					{ Fix $ Label $1 $3 } |	continue ';'						{ Fix $ Continue }-|	return ';'						{ Fix $ Return Nothing }-|	return Expr ';'						{ Fix $ Return (Just $2) } |	switch '(' Expr ')' '{' SwitchCases '}'			{ Fix $ SwitchStmt $3 (reverse $6) }+|	ReturnStmt						{ $1 } |	Comment							{ $1 } -IfStmt :: { NonTerm }-IfStmt-:	if '(' Expr ')' CompoundStmt				{ Fix $ IfStmt $3 $5 Nothing }-|	if '(' Expr ')' CompoundStmt else IfStmt		{ Fix $ IfStmt $3 $5 (Just $7) }-|	if '(' Expr ')' CompoundStmt else CompoundStmt		{ Fix $ IfStmt $3 $5 (Just $7) }+ReturnStmt :: { NonTerm }+ReturnStmt+:	return ';'						{ Fix $ Return Nothing }+|	return Expr ';'						{ Fix $ Return (Just $2) } +IfStmt(x)+:	if '(' Expr ')' x					{ Fix $ IfStmt $3 $5 Nothing }+|	if '(' Expr ')' x else x				{ Fix $ IfStmt $3 $5 (Just $7) }+|	if '(' Expr ')' x else IfStmt(x)			{ Fix $ IfStmt $3 $5 (Just $7) }+ ForStmt :: { NonTerm } ForStmt :	for '(' ForInit Expr ';' ForNext ')' CompoundStmt	{ Fix $ ForStmt $3 $4 $6 $8 }@@ -414,6 +429,7 @@ SwitchCaseBody :	CompoundStmt						{ $1 } |	SwitchCase						{ $1 }+|	break ';'						{ Fix $ Break } |	return Expr ';'						{ Fix $ Return (Just $2) }  DeclStmt :: { NonTerm }@@ -599,17 +615,20 @@ EnumeratorList :: { [NonTerm] } EnumeratorList :	'{' Enumerators '}'					{ reverse $2 }+|	'{' Enumerators ',' '}'					{ reverse $2 }+|	'{' Enumerators Comment '}'				{ reverse $2 }  -- TODO(iphydf): Don't throw away the comment.+|	'{' Enumerators ',' Comment '}'				{ reverse $2 }  -- TODO(iphydf): Don't throw away the comment.  Enumerators :: { [NonTerm] } Enumerators :	Enumerator						{ [$1] }-|	Enumerators Enumerator					{ $2 : $1 }+|	Enumerators ',' Enumerator				{ $3 : $1 }  Enumerator :: { NonTerm } Enumerator-:	EnumeratorName ','					{ Fix $ Enumerator $1 Nothing }-|	EnumeratorName '=' ConstExpr ','			{ Fix $ Enumerator $1 (Just $3) }-|	Comment							{ $1 }+:	EnumeratorName						{ Fix $ Enumerator $1 Nothing }+|	EnumeratorName '=' ConstExpr				{ Fix $ Enumerator $1 (Just $3) }+|	Comment Enumerator					{ Fix $ Commented $1 $2 }  EnumeratorName :: { Term } EnumeratorName@@ -649,7 +668,9 @@  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)) }@@ -745,11 +766,6 @@ tyPointer = Fix . TyPointer tyConst = Fix . TyConst -parseError :: Show text => (Lexeme text, [String]) -> Alex a-parseError (L (AlexPn _ line col) c t, options) =-    alexError $ ":" <> show line <> ":" <> show col <> ": Parse error near " <> show c <> ": "-        <> show t <> "; expected one of " <> show options- lexwrap :: (Lexeme Text -> Alex a) -> Alex a lexwrap = (alexMonadScan >>=) @@ -774,4 +790,11 @@ macroBodyStmt _ cond =     alexError $ show cond         <> ": macro do-while body must end in 'while (0)'"++source :: Maybe BS.ByteString+#ifdef SOURCE+source = Just $(embedFile SOURCE)+#else+source = Nothing+#endif }
src/Language/Cimple/Pretty.hs view
@@ -27,6 +27,7 @@ indentWidth :: Int indentWidth = 2 +kwBitwise       = dullgreen $ text "bitwise" kwBreak         = dullred   $ text "break" kwCase          = dullred   $ text "case" kwConst         = dullgreen $ text "const"@@ -37,6 +38,7 @@ 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"@@ -136,7 +138,7 @@     Ignore  -> text "//!TOKSTYLE-"  ppCommentBody :: [Lexeme Text] -> Doc-ppCommentBody body = vsep . prefixStars . map (hsep . map ppWord) . groupLines $ body+ppCommentBody body = vsep . prefixStars . map (hcat . map ppWord . spaceWords) . groupLines $ body   where     -- If the "*/" is on a separate line, don't add an additional "*" before     -- it. If "*/" is on the same line, then do add a "*" prefix on the last line.@@ -149,6 +151,21 @@         L _ PpNewline _ -> True         _               -> False +    spaceWords = \case+        (L c p s:ws) -> L c p (" "<>s):continue ws+        [] -> []+      where+        continue [] = []+        continue (w@(L _ CmtEnd _):ws) = w:continue ws+        continue (w@(L _ PctComma _):ws) = w:continue ws+        continue (w@(L _ PctPeriod _):ws) = w:continue ws+        continue (w@(L _ PctEMark _):ws) = w:continue ws+        continue (w@(L _ PctQMark _):ws) = w:continue ws+        continue (w@(L _ PctRParen _):ws) = w:continue ws+        continue [w@(L c p s), end@(L _ CmtEnd _)] | lexemeLine w == lexemeLine end = [L c p (" "<>s<>" "), end]+        continue (L c PctLParen s:w:ws) = (L c PctLParen (" "<>s)):w:continue ws+        continue (L c p s:ws) = (L c p (" "<>s)):continue ws+ ppWord (L _ CmtIndent  _) = empty ppWord (L _ CmtCommand t) = dullcyan   $ ppText t ppWord (L _ _          t) = dullyellow $ ppText t@@ -157,7 +174,7 @@ ppComment Ignore cs _ =     ppCommentStart Ignore <> hcat (map ppWord cs) <> dullyellow (text "//!TOKSTYLE+" <> line) ppComment style cs (L l c _) =-    nest 1 $ ppCommentStart style <+> ppCommentBody (cs ++ [L l c "*/"])+    nest 1 $ ppCommentStart style <> ppCommentBody (cs ++ [L l c "*/"])  ppInitialiserList :: [Doc] -> Doc ppInitialiserList l = lbrace <+> commaSep l <+> rbrace@@ -274,10 +291,22 @@     . renderS     . plain +ppCodeBody :: [Doc] -> Doc+ppCodeBody =+    vcat+    . zipWith (<>) (empty : commentStart " *"  )+    . map text+    . List.splitOn "\n"+    . renderS+    . plain+    . hcat++commentStart :: String -> [Doc]+commentStart = repeat . dullyellow . text+ ppCommentInfo :: Comment (Lexeme Text) -> Doc ppCommentInfo = foldFix go   where-  commentStart t = repeat (dullyellow (text t))   ppBody     = vcat . zipWith (<>) (        commentStart " * "  )   ppIndented = vcat . zipWith (<>) (empty : commentStart " *   ")   ppRef      = underline . cyan . ppLexeme@@ -310,6 +339,7 @@      DocParagraph docs -> ppIndented docs     DocLine docs -> fillSep docs+    DocCode begin code end -> ppLexeme begin <> ppCodeBody code <> ppLexeme end     DocList l -> ppVerbatimComment $ vcat l     DocOLItem num docs -> ppLexeme num <> char '.' <+> nest 3 (fillSep docs)     DocULItem docs sublist -> char '-' <+> nest 2 (vsep $ fillSep docs : sublist)@@ -332,10 +362,10 @@      LicenseDecl l cs -> ppLicenseDecl l cs     CopyrightDecl from (Just to) owner ->-        text " * Copyright © " <> ppLexeme from <> char '-' <> ppLexeme to <+>+        text " * Copyright © " <> ppLexeme from <> char '-' <> ppLexeme to <>         ppCommentBody owner     CopyrightDecl from Nothing owner ->-        text " * Copyright © " <> ppLexeme from <+>+        text " * Copyright © " <> ppLexeme from <>         ppCommentBody owner      Comment style _ cs end ->@@ -374,6 +404,8 @@     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@@ -389,7 +421,7 @@         ppToplevel decls <$>         line <>         dullmagenta (text "#ifdef __cplusplus") <$>-        rbrace <$>+        rbrace <+> text "/* extern \"C\" */" <$>         dullmagenta (text "#endif")      Group decls -> vcat decls@@ -418,17 +450,17 @@         dullmagenta (text "#if" <+> cond) <$>         ppToplevel decls <>         elseBranch <$>-        dullmagenta (text "#endif")+        dullmagenta (text "#endif  /*" <+> cond <+> text "*/")     PreprocIfdef name decls elseBranch ->         dullmagenta (text "#ifdef" <+> ppLexeme name) <$>         ppToplevel decls <>         elseBranch <$>-        dullmagenta (text "#endif  //" <+> ppLexeme name)+        dullmagenta (text "#endif  /*" <+> ppLexeme name <+> text "*/")     PreprocIfndef name decls elseBranch ->         dullmagenta (text "#ifndef" <+> ppLexeme name) <$>         ppToplevel decls <>         elseBranch <$>-        dullmagenta (text "#endif  //" <+> ppLexeme name)+        dullmagenta (text "#endif  /*" <+> ppLexeme name <+> text "*/")     PreprocElse [] -> empty     PreprocElse decls ->         linebreak <>
src/Language/Cimple/Tokens.hs view
@@ -13,6 +13,7 @@     | IdStdType     | IdSueType     | IdVar+    | KwBitwise     | KwBreak     | KwCase     | KwConst@@ -23,6 +24,7 @@     | KwEnum     | KwExtern     | KwFor+    | KwForce     | KwGnuPrintf     | KwGoto     | KwIf@@ -106,7 +108,6 @@     | CmtCommand     | CmtAttr     | CmtEndDocSection-    | CmtPrefix     | CmtIndent     | CmtStart     | CmtStartCode
src/Language/Cimple/TraverseAst.hs view
@@ -134,6 +134,11 @@             recurse docs         DocLine docs ->             recurse docs+        DocCode begin docs end -> do+            _ <- recurse begin+            _ <- recurse docs+            _ <- recurse end+            pure ()         DocList docs ->             recurse docs         DocOLItem docs sublist -> do@@ -421,6 +426,10 @@             _ <- recurse decl             _ <- recurse bits             pure ()+        TyBitwise ty ->+            recurse ty+        TyForce ty ->+            recurse ty         TyConst ty ->             recurse ty         TyPointer ty ->
src/Language/Cimple/TreeParser.y view
@@ -136,7 +136,12 @@  Header :: { NonTerm } Header-:	preprocIfndef						{% recurse parseHeaderBody $1 }+:	preprocIfndef ModeLine					{% recurse parseHeaderBody $1 }++ModeLine :: { Maybe NonTerm }+ModeLine+:								{ Nothing }+|	comment							{ Just $1 }  HeaderBody :: { [NonTerm] } HeaderBody
+ test/Language/Cimple/DescribeAstSpec.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}+module Language.Cimple.DescribeAstSpec where++import           Test.Hspec          (Spec, describe, it, shouldBe,+                                      shouldNotContain)++import qualified Data.List.Extra     as List+import           Data.Text           (Text)+import qualified Data.Text           as Text+import           Language.Cimple.IO  (parseExpr, parseStmt, parseText)+import           Language.CimpleSpec (sampleToken)+import           Test.QuickCheck     (Testable (property))+++expected :: (Text -> Either String a) -> Text -> String+expected parse code =+    case parse code of+        Left err -> snd $ List.breakOn "expected " err+        Right _  -> ""+++spec :: Spec+spec = do+    describe "error messages" $ do+        it "has useful suggestions" $ do+            parseText "int a() {}" `shouldBe` Left+                ":1:10: Parse error near right brace: \"}\"; expected statement or declaration"++            expected parseText "Beep Boop" `shouldBe`+                "expected variable name"++            expected parseText "const *a() {}" `shouldBe`+                "expected type specifier"++            expected parseText "int a() { int }" `shouldBe`+                "expected variable name"++            expected parseStmt "(int){" `shouldBe`+                "expected constant or literal"++        it "has suggestions for any sequence of tokens in top level" $ do+            property $ \tokens ->+                expected parseText (Text.intercalate " " (map sampleToken tokens)) `shouldNotContain`+                    "expected one of"++        it "has suggestions for any sequence of tokens in expressions" $ do+            property $ \tokens ->+                expected parseExpr (Text.intercalate " " (map sampleToken tokens)) `shouldNotContain`+                    "expected one of"++        it "has suggestions for any sequence of tokens in statements" $ do+            property $ \tokens ->+                expected parseStmt (Text.intercalate " " (map sampleToken tokens)) `shouldNotContain`+                    "expected one of"++        it "does not support multiple declarators per declaration" $ do+            let ast = parseText "int main() { int a, b; }"+            ast `shouldBe` Left+                ":1:19: Parse error near comma: \",\"; expected '=' or ';'"
test/Language/Cimple/ParserSpec.hs view
@@ -49,8 +49,3 @@                               (L (AlexPn 17 1 18) IdVar "a")                               [])) Nothing)])))                 ]--        it "does not support multiple declarators per declaration" $ do-            let ast = parseText "int main() { int a, b; }"-            ast `shouldBe` Left-                ":1:19: Parse error near PctComma: \",\"; expected one of [\"'='\",\"';'\"]"
test/Language/Cimple/PrettySpec.hs view
@@ -69,7 +69,7 @@          it "respects newlines at end of comments" $ do             compact "/* foo bar */" `shouldBe` "/* foo bar */\n"-            compact "/* foo bar\n */" `shouldBe` "/* foo bar\n*/\n"+            compact "/* foo bar\n */" `shouldBe` "/* foo bar\n */\n"          it "respects comment styles" $ do             compact "/* foo bar */" `shouldBe` "/* foo bar */\n"@@ -79,11 +79,11 @@          it "supports punctuation in comments" $ do             compact "/* foo.bar,baz-blep */"-                `shouldBe` "/* foo . bar , baz - blep */\n"-            compact "/* foo? */" `shouldBe` "/* foo ? */\n"+                `shouldBe` "/* foo.bar, baz-blep */\n"+            compact "/* foo? */" `shouldBe` "/* foo?*/\n"             compact "/* 123 - 456 */" `shouldBe` "/* 123 - 456 */\n"             compact "/* - 3 */" `shouldBe` "/* - 3 */\n"-            compact "/* a-b */" `shouldBe` "/* a - b */\n"+            compact "/* a-b */" `shouldBe` "/* a-b*/\n"          it "formats pointer types with east-const" $ do             compact "void foo(const int *a);"
+ test/Language/CimpleSpec.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}+module Language.CimpleSpec where++import           Test.Hspec      (Spec, describe, it, shouldNotBe)++import           Data.Text       (Text)+import           Language.Cimple (LexemeClass (..))+import           Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum, forAll,+                                  suchThat)++instance Arbitrary LexemeClass where+    arbitrary = arbitraryBoundedEnum `suchThat` ok+      where+        ok ErrorToken = False+        ok Eof        = False+        ok _          = True+++sampleToken :: LexemeClass -> Text+sampleToken c = case c of+    IdConst               -> "ID_CONST"+    IdFuncType            -> "func_cb"+    IdStdType             -> "uint32_t"+    IdSueType             -> "Sue_Type"+    IdVar                 -> "var"+    KwBitwise             -> "bitwise"+    KwBreak               -> "break"+    KwCase                -> "case"+    KwConst               -> "const"+    KwContinue            -> "continue"+    KwDefault             -> "default"+    KwDo                  -> "do"+    KwElse                -> "else"+    KwEnum                -> "enum"+    KwExtern              -> "extern"+    KwFor                 -> "for"+    KwForce               -> "force"+    KwGnuPrintf           -> "gnu_printf"+    KwGoto                -> "goto"+    KwIf                  -> "if"+    KwNonNull             -> "non_null"+    KwNullable            -> "nullable"+    KwReturn              -> "return"+    KwSizeof              -> "sizeof"+    KwStatic              -> "static"+    KwStaticAssert        -> "static_assert"+    KwStruct              -> "struct"+    KwSwitch              -> "switch"+    KwTypedef             -> "typedef"+    KwUnion               -> "union"+    KwVla                 -> "VLA"+    KwVoid                -> "void"+    KwWhile               -> "while"+    LitFalse              -> "false"+    LitTrue               -> "true"+    LitChar               -> "'a'"+    LitInteger            -> "123"+    LitString             -> "\"str\""+    LitSysInclude         -> "<stdio.h>"+    PctAmpersand          -> "&"+    PctAmpersandAmpersand -> "&&"+    PctAmpersandEq        -> "&="+    PctArrow              -> "->"+    PctAsterisk           -> "*"+    PctAsteriskEq         -> "*="+    PctCaret              -> "^"+    PctCaretEq            -> "^="+    PctColon              -> ":"+    PctComma              -> ","+    PctEllipsis           -> "..."+    PctEMark              -> "!"+    PctEMarkEq            -> "!="+    PctEq                 -> "="+    PctEqEq               -> "=="+    PctGreater            -> ">"+    PctGreaterEq          -> ">="+    PctGreaterGreater     -> ">>"+    PctGreaterGreaterEq   -> ">>="+    PctLBrace             -> "{\n"+    PctLBrack             -> "["+    PctLess               -> "<"+    PctLessEq             -> "<="+    PctLessLess           -> "<<"+    PctLessLessEq         -> "<<="+    PctLParen             -> "("+    PctMinus              -> "-"+    PctMinusEq            -> "-="+    PctMinusMinus         -> "--"+    PctPeriod             -> "."+    PctPercent            -> "%"+    PctPercentEq          -> "%="+    PctPipe               -> "|"+    PctPipeEq             -> "|="+    PctPipePipe           -> "||"+    PctPlus               -> "+"+    PctPlusEq             -> "+="+    PctPlusPlus           -> "++"+    PctQMark              -> "?"+    PctRBrace             -> "}"+    PctRBrack             -> "]"+    PctRParen             -> ")"+    PctSemicolon          -> ";\n"+    PctSlash              -> "/"+    PctSlashEq            -> "/="+    PctTilde              -> "~"+    PpDefine              -> "\n#define"+    PpDefined             -> "\n#defined"+    PpElif                -> "\n#elif"+    PpElse                -> "\n#else"+    PpEndif               -> "\n#endif"+    PpIf                  -> "\n#if"+    PpIfdef               -> "\n#ifdef"+    PpIfndef              -> "\n#ifndef"+    PpInclude             -> "\n#include"+    PpNewline             -> "\n"+    PpUndef               -> "\n#undef"+    CmtBlock              -> "/**"+    CmtCommand            -> "@param"+    CmtAttr               -> "[out]"+    CmtEndDocSection      -> "/** @} */"+    CmtIndent             -> "*"+    CmtStart              -> "/*"+    CmtStartCode          -> "/*!"+    CmtStartBlock         -> "/***"+    CmtStartDoc           -> "/**"+    CmtStartDocSection    -> "/** @{"+    CmtSpdxCopyright      -> "Copyright ©"+    CmtSpdxLicense        -> "SPDX-License-Identifier:"+    CmtCode               -> "@code"+    CmtWord               -> "hello"+    CmtRef                -> "`ref`"+    CmtEnd                -> "*/\n"+    IgnStart              -> "\n//!TOKSTYLE-\n"+    IgnBody               -> "ignored stuff"+    IgnEnd                -> "\n//!TOKSTYLE+\n"++    ErrorToken            -> "!!ERROR!!"+    Eof                   -> "!!EOF!!"++spec :: Spec+spec = do+    describe "tokens" $ do+        it "can be turned into strings" $+            forAll arbitraryBoundedEnum $ \token ->+                sampleToken token `shouldNotBe` ""