cimple 0.0.1 → 0.0.2

raw patch · 18 files changed

+1428/−383 lines, 18 filesdep +ansi-wl-pprintdep +filepathdep −compactnew-component:exe:cimplefmtnew-component:exe:include-graphPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: ansi-wl-pprint, filepath

Dependencies removed: compact

API changes (from Hackage documentation)

Files

• cimple.cabal +37/−2
• src/Language/Cimple/AST.hs +19/−5
• src/Language/Cimple/Diagnostics.hs +5/−1
• src/Language/Cimple/Graph.hs +30/−0
• src/Language/Cimple/IO.hs +40/−25
• src/Language/Cimple/Lexer.x +12/−8
• src/Language/Cimple/Parser.y +366/−303
• src/Language/Cimple/Pretty.hs +567/−0
• src/Language/Cimple/Program.hs +43/−0
• src/Language/Cimple/SemCheck/Includes.hs +59/−0
• src/Language/Cimple/Tokens.hs +5/−1
• src/Language/Cimple/TranslationUnit.hs +9/−0
• src/Language/Cimple/TraverseAst.hs +29/−16
• test/Language/Cimple/PrettySpec.hs +119/−0
• test/Language/CimpleSpec.hs +36/−8
• tools/cimplefmt.hs +20/−0
• tools/dump-ast.hs +12/−14
• tools/include-graph.hs +20/−0

@@ -1,5 +1,5 @@ name:                 cimple-version:              0.0.1+version:              0.0.2 synopsis:             Simple C-like programming language homepage:             https://toktok.github.io/ license:              GPL-3@@ -29,22 +29,40 @@       Language.Cimple     , Language.Cimple.Diagnostics     , Language.Cimple.IO+    , Language.Cimple.Pretty+    , Language.Cimple.Program     , Language.Cimple.TraverseAst   other-modules:       Language.Cimple.AST+    , Language.Cimple.Graph     , Language.Cimple.Lexer     , Language.Cimple.Parser+    , Language.Cimple.SemCheck.Includes     , Language.Cimple.Tokens+    , Language.Cimple.TranslationUnit   build-depends:       base < 5     , aeson+    , ansi-wl-pprint     , array     , bytestring-    , compact     , containers+    , filepath+    , groom     , mtl     , text +executable cimplefmt+  default-language: Haskell2010+  hs-source-dirs:+      tools+  ghc-options:+      -Wall+  main-is: cimplefmt.hs+  build-depends:+      base < 5+    , cimple+ executable dump-ast   default-language: Haskell2010   hs-source-dirs:@@ -73,6 +91,18 @@     , groom     , text +executable include-graph+  default-language: Haskell2010+  hs-source-dirs:+      tools+  ghc-options:+      -Wall+  main-is: include-graph.hs+  build-depends:+      base < 5+    , cimple+    , groom+ test-suite testsuite   type: exitcode-stdio-1.0   default-language: Haskell2010@@ -80,10 +110,15 @@   main-is: testsuite.hs   other-modules:       Language.CimpleSpec+    , Language.Cimple.PrettySpec   ghc-options:       -Wall       -fno-warn-unused-imports+  build-tool-depends:+      hspec-discover:hspec-discover   build-depends:       base < 5+    , ansi-wl-pprint     , cimple     , hspec+    , text

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveFunctor     #-} {-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE StrictData        #-} module Language.Cimple.AST     ( AssignOp (..)     , BinaryOp (..)@@ -8,6 +9,7 @@     , LiteralType (..)     , Node (..)     , Scope (..)+    , CommentStyle (..)     ) where  import           Data.Aeson   (FromJSON, ToJSON)@@ -24,15 +26,17 @@     | PreprocIfndef lexeme [Node lexeme] (Node lexeme)     | PreprocElse [Node lexeme]     | PreprocElif (Node lexeme) [Node lexeme] (Node lexeme)-    | PreprocError lexeme     | PreprocUndef lexeme     | PreprocDefined lexeme     | PreprocScopedDefine (Node lexeme) [Node lexeme] (Node lexeme)     | MacroBodyStmt [Node lexeme]     | MacroBodyFunCall (Node lexeme)     | MacroParam lexeme+    | StaticAssert (Node lexeme) lexeme     -- Comments-    | Comment [Node lexeme]+    | LicenseDecl lexeme [Node lexeme]+    | CopyrightDecl lexeme (Maybe lexeme) [lexeme]+    | Comment CommentStyle lexeme [Node lexeme] lexeme     | CommentBlock lexeme     | CommentWord lexeme     | Commented (Node lexeme) (Node lexeme)@@ -46,9 +50,9 @@     | Goto lexeme     | Continue     | Return (Maybe (Node lexeme))-    | Switch (Node lexeme) [Node lexeme]+    | SwitchStmt (Node lexeme) [Node lexeme]     | IfStmt (Node lexeme) [Node lexeme] (Maybe (Node lexeme))-    | ForStmt (Maybe (Node lexeme)) (Maybe (Node lexeme)) (Maybe (Node lexeme)) [Node lexeme]+    | ForStmt (Node lexeme) (Node lexeme) (Node lexeme) [Node lexeme]     | WhileStmt (Node lexeme) [Node lexeme]     | DoWhileStmt [Node lexeme] (Node lexeme)     | Case (Node lexeme) (Node lexeme)@@ -56,7 +60,7 @@     | Label lexeme (Node lexeme)     -- Variable declarations     | VLA (Node lexeme) lexeme (Node lexeme)-    | VarDecl (Node lexeme) [Node lexeme]+    | VarDecl (Node lexeme) (Node lexeme)     | Declarator (Node lexeme) (Maybe (Node lexeme))     | DeclSpecVar lexeme     | DeclSpecArray (Node lexeme) (Maybe (Node lexeme))@@ -69,6 +73,7 @@     | ParenExpr (Node lexeme)     | CastExpr (Node lexeme) (Node lexeme)     | SizeofExpr (Node lexeme)+    | SizeofType (Node lexeme)     | LiteralExpr LiteralType lexeme     | VarExpr lexeme     | MemberAccess (Node lexeme) lexeme@@ -187,3 +192,12 @@  instance FromJSON Scope instance ToJSON Scope++data CommentStyle+    = Regular+    | Doxygen+    | Block+    deriving (Show, Eq, Generic)++instance FromJSON CommentStyle+instance ToJSON CommentStyle

@@ -1,5 +1,9 @@ {-# LANGUAGE OverloadedStrings #-}-module Language.Cimple.Diagnostics (Diagnostics, warn) where+{-# LANGUAGE StrictData        #-}+module Language.Cimple.Diagnostics+  ( Diagnostics+  , warn+  ) where  import           Control.Monad.State.Lazy (State) import qualified Control.Monad.State.Lazy as State

@@ -0,0 +1,30 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData      #-}+module Language.Cimple.Graph+  ( Graph+  , fromEdges+  , edges+  ) where++import qualified Data.Graph as G++data Graph node key = Graph+    { graph          :: G.Graph+    , nodeFromVertex :: G.Vertex -> (node, key, [key])+    , vertexFromKey  :: key -> Maybe G.Vertex+    }++fromEdges :: Ord key => [(node, key, [key])] -> Graph node key+fromEdges es = Graph{..}+  where+    (graph, nodeFromVertex, vertexFromKey) = G.graphFromEdges es++edges :: Graph node key -> [(key, key)]+edges Graph{..} = map resolve . G.edges $ graph+  where+    resolve (from, to) =+      let+          (_, from', _) = nodeFromVertex from+          (_, to', _) = nodeFromVertex to+      in+      (from', to')

@@ -1,24 +1,28 @@+{-# LANGUAGE StrictData #-} module Language.Cimple.IO     ( parseFile+    , parseFiles+    , parseProgram     , parseText     ) where -import           Control.Monad.State.Lazy (State, get, put, runState)-import qualified Data.ByteString          as BS-import qualified Data.Compact             as Compact-import           Data.Map.Strict          (Map)-import qualified Data.Map.Strict          as Map-import           Data.Text                (Text)-import qualified Data.Text                as Text-import qualified Data.Text.Encoding       as Text-import           Language.Cimple.AST      (Node (..))-import           Language.Cimple.Lexer    (Lexeme, runAlex)-import           Language.Cimple.Parser   (parseCimple)-+import           Control.Monad.State.Lazy        (State, evalState, get, put)+import qualified Data.ByteString                 as BS+import           Data.Map.Strict                 (Map)+import qualified Data.Map.Strict                 as Map+import           Data.Text                       (Text)+import qualified Data.Text                       as Text+import qualified Data.Text.Encoding              as Text+import           Language.Cimple.AST             (Node (..))+import           Language.Cimple.Lexer           (Lexeme, runAlex)+import           Language.Cimple.Parser          (parseCimple)+import           Language.Cimple.Program         (Program)+import qualified Language.Cimple.Program         as Program+import           Language.Cimple.TranslationUnit (TranslationUnit) -type CompactState a = State (Map String Text) a+type CacheState a = State (Map String Text) a -cacheText :: String -> CompactState Text+cacheText :: String -> CacheState Text cacheText s = do     m <- get     case Map.lookup s m of@@ -30,22 +34,33 @@             return text  -process :: [Node (Lexeme String)] -> IO [Node (Lexeme Text)]-process stringAst = do-    let (textAst, _) = runState (mapM (mapM (mapM cacheText)) stringAst) Map.empty-    Compact.getCompact <$> Compact.compactWithSharing textAst+process :: [Node (Lexeme String)] -> [Node (Lexeme Text)]+process stringAst =+    evalState (mapM (mapM (mapM cacheText)) stringAst) Map.empty  -parseText :: Text -> IO (Either String [Node (Lexeme Text)])+parseText :: Text -> Either String [Node (Lexeme Text)] parseText contents =-    mapM process res+    process <$> res   where     res :: Either String [Node (Lexeme String)]     res = runAlex (Text.unpack contents) parseCimple  -parseFile :: FilePath -> IO (Either String [Node (Lexeme Text)])-parseFile source = do-    putStrLn $ "Processing " ++ source-    contents <- Text.decodeUtf8 <$> BS.readFile source-    parseText contents+parseFile :: FilePath -> IO (Either String (TranslationUnit Text))+parseFile source =+    addSource . parseText . Text.decodeUtf8 <$> BS.readFile source+  where+    -- Add source filename to the error message, if any.+    addSource (Left err) = Left $ "In file \"" <> source <> "\": " <> err+    -- If there's no error message, record the source filename in the returned+    -- TranslationUnit.+    addSource (Right ok) = Right (source, ok)+++parseFiles :: [FilePath] -> IO (Either String [TranslationUnit Text])+parseFiles sources = sequenceA <$> traverse parseFile sources+++parseProgram :: [FilePath] -> IO (Either String (Program Text))+parseProgram sources = (>>= Program.fromList) <$> parseFiles sources

@@ -82,9 +82,8 @@ <0,ppSC>	"crypto_box_"[A-Z][A-Z0-9_]*		{ mkL IdConst } <0,ppSC>	"crypto_hash_sha256_"[A-Z][A-Z0-9_]*	{ mkL IdConst } <0,ppSC>	"crypto_hash_sha512_"[A-Z][A-Z0-9_]*	{ mkL IdConst }+<0,ppSC>	"crypto_pwhash_scryptsalsa208sha256_"[A-Z][A-Z0-9_]*		{ mkL IdConst } <0,ppSC>	"crypto_sign_"[A-Z][A-Z0-9_]*		{ mkL IdConst }-<0>		"MAX"					{ mkL IdConst }-<0>		"MIN"					{ mkL IdConst }  -- Standard C (ish). <ppSC>		defined					{ mkL PpDefined }@@ -100,8 +99,9 @@ <0,ppSC>	"// ".*					; <0>		$white+					; <0>		"//!TOKSTYLE-"				{ start ignoreSC }-<0>		"/*""*"?				{ mkL CmtStart `andBegin` cmtSC }-<0>		"/""*"+\n" *"\n" * :: ".+\n" *"\n" ""*"+"/"	{ mkL CmtBlock }+<0>		"/*"					{ mkL CmtStart `andBegin` cmtSC }+<0>		"/**"					{ mkL CmtStartDoc `andBegin` cmtSC }+<0>		"/**""*"+				{ mkL CmtStartBlock `andBegin` cmtSC } <0,cmtSC>	\"(\\.|[^\"])*\"			{ mkL LitString } <0>		'(\\|[^'])*'				{ mkL LitChar } <0>		"<"[a-z0-9\.\/_]+">"			{ mkL LitSysInclude }@@ -114,7 +114,6 @@ <0>		"#define"				{ mkL PpDefine `andBegin` ppSC } <0>		"#undef"				{ mkL PpUndef } <0>		"#include"				{ mkL PpInclude }-<0>		"#error"				{ mkL PpError } <0,ppSC>	"bitmask"				{ mkL KwBitmask } <0,ppSC>	"break"					{ mkL KwBreak } <0,ppSC>	"case"					{ mkL KwCase }@@ -135,6 +134,7 @@ <0,ppSC>	"return"				{ mkL KwReturn } <0,ppSC>	"sizeof"				{ mkL KwSizeof } <0,ppSC>	"static"				{ mkL KwStatic }+<0,ppSC>	"static_assert"				{ mkL KwStaticAssert } <0,ppSC>	"struct"				{ mkL KwStruct } <0,ppSC>	"switch"				{ mkL KwSwitch } <0,ppSC>	"this"					{ mkL KwThis }@@ -233,15 +233,19 @@ <cmtSC>		"http://"[^ ]+				{ mkL CmtWord } <cmtSC>		[0-9]+"%"				{ mkL LitInteger } <cmtSC>		"`"([^`]|"\`")+"`"			{ mkL CmtCode }+<cmtSC>		"–"					{ mkL CmtWord } <cmtSC>		"*/"					{ mkL CmtEnd `andBegin` 0 }-<cmtSC>		\n" "+"*/"				{ mkL CmtEnd `andBegin` 0 }-<cmtSC,codeSC>	\n" "+"*"				{ mkL PpNewline }-<cmtSC,codeSC>	\n					{ mkL PpNewline }+<cmtSC>		\n					{ mkL PpNewline `andBegin` cmtNewlineSC } <cmtSC>		" "+					; +<cmtNewlineSC>	" "+"*"+"/"				{ mkL CmtEnd `andBegin` 0 }+<cmtNewlineSC>	" "+"*"					{ mkL CmtIndent `andBegin` cmtSC }+ -- <code></code> blocks in comments. <codeSC>	"@endcode"				{ mkL CmtCode `andBegin` cmtSC } <codeSC>	"</code>"				{ mkL CmtCode `andBegin` cmtSC }+<codeSC>	\n					{ mkL PpNewline }+<codeSC>	\n" "+"*"				{ mkL PpNewline } <codeSC>	[^@\<]+					{ mkL CmtCode }  -- Error handling.

@@ -2,8 +2,8 @@ module Language.Cimple.Parser where  import           Language.Cimple.AST    (AssignOp (..), BinaryOp (..),-                                         LiteralType (..), Node (..),-                                         Scope (..), UnaryOp (..))+                                         CommentStyle (..), LiteralType (..),+                                         Node (..), Scope (..), UnaryOp (..)) import           Language.Cimple.Lexer  (Alex, AlexPosn, Lexeme (..), alexError,                                          alexMonadScan) import           Language.Cimple.Tokens (LexemeClass (..))@@ -14,6 +14,7 @@  %name parseCimple %error {parseError}+%errorhandlertype explist %lexer {lexwrap} {L _ Eof _} %monad {Alex} %tokentype {Lexeme String}@@ -44,6 +45,7 @@     return			{ L _ KwReturn			_ }     sizeof			{ L _ KwSizeof			_ }     static			{ L _ KwStatic			_ }+    static_assert		{ L _ KwStaticAssert		_ }     struct			{ L _ KwStruct			_ }     switch			{ L _ KwSwitch			_ }     this			{ L _ KwThis			_ }@@ -110,7 +112,6 @@     '#elif'			{ L _ PpElif			_ }     '#else'			{ L _ PpElse			_ }     '#endif'			{ L _ PpEndif			_ }-    '#error'			{ L _ PpError			_ }     '#if'			{ L _ PpIf			_ }     '#ifdef'			{ L _ PpIfdef			_ }     '#ifndef'			{ L _ PpIfndef			_ }@@ -119,12 +120,15 @@     '\n'			{ L _ PpNewline			_ }     '/**/'			{ L _ CmtBlock			_ }     '/*'			{ L _ CmtStart			_ }+    '/**'			{ L _ CmtStartDoc		_ }+    '/***'			{ L _ CmtStartBlock		_ }+    ' * '			{ L _ CmtIndent			_ }     '*/'			{ L _ CmtEnd			_ }     'Copyright'			{ L _ CmtSpdxCopyright		_ }     'License'			{ L _ CmtSpdxLicense		_ }-    COMMENT_CODE		{ L _ CmtCode			_ }-    COMMENT_WORD		{ L _ CmtWord			_ }-    COMMENT_REF			{ L _ CmtRef			_ }+    CMT_CODE			{ L _ CmtCode			_ }+    CMT_WORD			{ L _ CmtWord			_ }+    CMT_REF			{ L _ CmtRef			_ }  %left ',' %right '=' '+=' '-=' '*=' '/=' '%=' '<<=' '>>=' '&=' '^=' '|='@@ -146,155 +150,194 @@  TranslationUnit :: { [StringNode] } TranslationUnit-:	ToplevelDecls							{ reverse $1 }+:	ToplevelDecls						{ reverse $1 }+|	LicenseDecl ToplevelDecls				{ $1 : reverse $2 } +LicenseDecl :: { StringNode }+LicenseDecl+:	'/*' 'License' CMT_WORD '\n' CopyrightDecls '*/'	{ LicenseDecl $3 $5 }++CopyrightDecls :: { [StringNode] }+CopyrightDecls+:	CopyrightDecl						{ [$1] }+|	CopyrightDecls CopyrightDecl				{ $2 : $1 }++CopyrightDecl :: { StringNode }+CopyrightDecl+:	' * ' 'Copyright' CopyrightDates CopyrightOwner '\n'	{ CopyrightDecl (fst $3) (snd $3) $4 }++CopyrightDates :: { (StringLexeme, Maybe StringLexeme) }+CopyrightDates+:	LIT_INTEGER						{ ($1, Nothing) }+|	LIT_INTEGER '-' LIT_INTEGER				{ ($1, Just $3) }++CopyrightOwner :: { [StringLexeme] }+CopyrightOwner+:	CMT_WORD CommentWords					{ $1 : reverse $2 }+ ToplevelDecls :: { [StringNode] } ToplevelDecls-:	ToplevelDecl							{ [$1] }-|	ToplevelDecls ToplevelDecl					{ $2 : $1 }+:	ToplevelDecl						{ [$1] }+|	ToplevelDecls ToplevelDecl				{ $2 : $1 }  ToplevelDecl :: { StringNode } ToplevelDecl-:	PreprocIfdef(ToplevelDecls)					{ $1 }-|	PreprocIf(ToplevelDecls)					{ $1 }-|	PreprocInclude							{ $1 }-|	PreprocDefine							{ $1 }-|	PreprocUndef							{ $1 }-|	PreprocError							{ $1 }-|	ExternC								{ $1 }-|	TypedefDecl							{ $1 }-|	AggregateDecl							{ $1 }-|	EnumDecl							{ $1 }-|	FunctionDecl							{ $1 }-|	ConstDecl							{ $1 }-|	Comment								{ $1 }-|	Namespace							{ $1 }-|	Event								{ $1 }-|	ErrorDecl							{ $1 }+:	PreprocIfdef(ToplevelDecls)				{ $1 }+|	PreprocIf(ToplevelDecls)				{ $1 }+|	PreprocInclude						{ $1 }+|	PreprocUndef						{ $1 }+|	ExternC							{ $1 }+|	Comment							{ $1 }+|	Namespace						{ $1 }+|	Event							{ $1 }+|	ErrorDecl						{ $1 }+|	StaticAssert						{ $1 }+|	Commented(CommentableDecl)				{ $1 } +CommentableDecl :: { StringNode }+CommentableDecl+:	TypedefDecl						{ $1 }+|	AggregateDecl						{ $1 }+|	EnumDecl						{ $1 }+|	FunctionDecl						{ $1 }+|	ConstDecl						{ $1 }+|	PreprocDefine						{ $1 }++DocComment :: { StringNode }+DocComment+:	'/**' CommentTokens '*/'				{ Comment Doxygen $1 (reverse $2) $3 }++StaticAssert :: { StringNode }+StaticAssert+:	static_assert '(' ConstExpr ',' LIT_STRING ')' ';'	{ StaticAssert $3 $5 }+ Namespace :: { StringNode } Namespace-:	NamespaceDeclarator						{ $1 Global }-|	static NamespaceDeclarator					{ $2 Static }+:	NamespaceDeclarator					{ $1 Global }+|	static NamespaceDeclarator				{ $2 Static }  NamespaceDeclarator :: { Scope -> StringNode } NamespaceDeclarator-:	class ID_SUE_TYPE TypeParams '{' ToplevelDecls '}'		{ \s -> Class s $2 $3 $5 }-|	namespace IdVar '{' ToplevelDecls '}'				{ \s -> Namespace s $2 $4 }+:	class ID_SUE_TYPE TypeParams '{' ToplevelDecls '}'	{ \s -> Class s $2 $3 (reverse $5) }+|	namespace IdVar '{' ToplevelDecls '}'			{ \s -> Namespace s $2 (reverse $4) }  TypeParams :: { [StringNode] } TypeParams-:									{ [] }-|	'<' ID_TYVAR '>'						{ [TyVar $2] }+:								{ [] }+|	'<' ID_TYVAR '>'					{ [TyVar $2] }  Event :: { StringNode } Event-:	event IdVar       '{' EventType '}'				{ Event $2 $4 }-|	event IdVar const '{' EventType '}'				{ Event $2 $5 }+:	event IdVar       '{' Commented(EventType) '}'		{ Event $2 $4 }+|	event IdVar const '{' Commented(EventType) '}'		{ Event $2 $5 }  EventType :: { StringNode } EventType-:	Comment typedef void EventParams ';'				{ Commented $1 $4 }+:	typedef void EventParams ';'				{ $3 }  EventParams :: { StringNode } EventParams-:	FunctionParamList						{ EventParams $1 }+:	FunctionParamList					{ EventParams $1 }  ErrorDecl :: { StringNode } ErrorDecl-:	'error' for IdVar EnumeratorList				{ ErrorDecl $3 $4 }+:	'error' for IdVar EnumeratorList			{ ErrorDecl $3 $4 }  Comment :: { StringNode } Comment-:	'/*' CommentBody '*/'						{ Comment (reverse $2) }-|	'/**/'								{ CommentBlock $1 }+:	'/*' CommentTokens '*/'					{ Comment Regular $1 (reverse $2) $3 }+|	'/***' CommentTokens '*/'				{ Comment Block $1 (reverse $2) $3 }+|	'/**/'							{ CommentBlock $1 } -CommentBody :: { [StringNode] }-CommentBody-:	CommentWord							{ [$1] }-|	CommentBody CommentWord						{ $2 : $1 }+CommentTokens :: { [StringNode] }+CommentTokens+:	CommentToken						{ [$1] }+|	CommentTokens CommentToken				{ $2 : $1 } -CommentWord :: { StringNode }+CommentToken :: { StringNode }+CommentToken+:	CommentWord						{ CommentWord $1 }+|	'\n'							{ CommentWord $1 }+|	' * '							{ CommentWord $1 }++CommentWords :: { [StringLexeme] }+CommentWords+:								{ [] }+|	CommentWords CommentWord				{ $2 : $1 }++CommentWord :: { StringLexeme } CommentWord-:	COMMENT_WORD							{ CommentWord $1 }-|	COMMENT_REF							{ CommentWord $1 }-|	COMMENT_CODE							{ CommentWord $1 }-|	LIT_INTEGER							{ CommentWord $1 }-|	LIT_STRING							{ CommentWord $1 }-|	'Copyright'							{ CommentWord $1 }-|	'License'							{ CommentWord $1 }-|	'.'								{ CommentWord $1 }-|	'?'								{ CommentWord $1 }-|	'!'								{ CommentWord $1 }-|	','								{ CommentWord $1 }-|	';'								{ CommentWord $1 }-|	':'								{ CommentWord $1 }-|	'('								{ CommentWord $1 }-|	')'								{ CommentWord $1 }-|	'<'								{ CommentWord $1 }-|	'>'								{ CommentWord $1 }-|	'/'								{ CommentWord $1 }-|	'+'								{ CommentWord $1 }-|	'-'								{ CommentWord $1 }-|	'='								{ CommentWord $1 }-|	'\n'								{ CommentWord $1 }+:	CMT_WORD						{ $1 }+|	CMT_REF							{ $1 }+|	CMT_CODE						{ $1 }+|	LIT_INTEGER						{ $1 }+|	LIT_STRING						{ $1 }+|	'.'							{ $1 }+|	'?'							{ $1 }+|	'!'							{ $1 }+|	','							{ $1 }+|	';'							{ $1 }+|	':'							{ $1 }+|	'('							{ $1 }+|	')'							{ $1 }+|	'<'							{ $1 }+|	'>'							{ $1 }+|	'/'							{ $1 }+|	'+'							{ $1 }+|	'-'							{ $1 }+|	'='							{ $1 }  PreprocIfdef(decls)-:	'#ifdef' ID_CONST decls PreprocElse(decls) '#endif'		{ PreprocIfdef $2 $3 $4 }-|	'#ifndef' ID_CONST decls PreprocElse(decls) '#endif'		{ PreprocIfndef $2 $3 $4 }+:	'#ifdef' ID_CONST decls PreprocElse(decls) '#endif'	{ PreprocIfdef $2 (reverse $3) $4 }+|	'#ifndef' ID_CONST decls PreprocElse(decls) '#endif'	{ PreprocIfndef $2 (reverse $3) $4 }  PreprocIf(decls)-:	'#if' ConstExpr '\n' decls PreprocElse(decls) '#endif'		{ PreprocIf $2 $4 $5 }+:	'#if' PreprocConstExpr '\n' decls PreprocElse(decls) '#endif'	{ PreprocIf $2 (reverse $4) $5 }  PreprocElse(decls)-:									{ PreprocElse [] }-|	'#else' decls							{ PreprocElse $2 }-|	'#elif' ConstExpr '\n' decls PreprocElse(decls)			{ PreprocElif $2 $4 $5 }--PreprocError :: { StringNode }-PreprocError-:	'#error' LIT_STRING						{ PreprocError $2 }+:								{ PreprocElse [] }+|	'#else' decls						{ PreprocElse $2 }+|	'#elif' PreprocConstExpr '\n' decls PreprocElse(decls)	{ PreprocElif $2 (reverse $4) $5 }  PreprocInclude :: { StringNode } PreprocInclude-:	'#include' LIT_STRING						{ PreprocInclude $2 }-|	'#include' LIT_SYS_INCLUDE					{ PreprocInclude $2 }+:	'#include' LIT_STRING					{ PreprocInclude $2 }+|	'#include' LIT_SYS_INCLUDE				{ PreprocInclude $2 }  PreprocDefine :: { StringNode } PreprocDefine-:	'#define' ID_CONST '\n'						{ PreprocDefine $2 }-|	'#define' ID_CONST ConstExpr '\n'				{ PreprocDefineConst $2 $3 }-|	'#define' ID_CONST MacroParamList MacroBody '\n'		{ PreprocDefineMacro $2 $3 $4 }+:	'#define' ID_CONST '\n'					{ PreprocDefine $2 }+|	'#define' ID_CONST PreprocSafeExpr(ConstExpr) '\n'	{ PreprocDefineConst $2 $3 }+|	'#define' ID_CONST MacroParamList MacroBody '\n'	{ PreprocDefineMacro $2 $3 $4 }  PreprocUndef :: { StringNode } PreprocUndef-:	'#undef' ID_CONST						{ PreprocUndef $2 }+:	'#undef' ID_CONST					{ PreprocUndef $2 } -ConstExpr :: { StringNode }-ConstExpr-:	LiteralExpr							{ $1 }-|	'defined' '(' ID_CONST ')'					{ PreprocDefined $3 }-|	PureExpr(ConstExpr)						{ $1 }+PreprocConstExpr :: { StringNode }+PreprocConstExpr+:	PureExpr(PreprocConstExpr)				{ $1 }+|	'defined' '(' ID_CONST ')'				{ PreprocDefined $3 }  MacroParamList :: { [StringNode] } MacroParamList-:	'(' ')'								{ [] }-|	'(' MacroParams ')'						{ reverse $2 }-|	'(' MacroParams ',' '...' ')'					{ reverse $ Ellipsis : $2 }+:	'(' ')'							{ [] }+|	'(' MacroParams ')'					{ reverse $2 }+|	'(' MacroParams ',' '...' ')'				{ reverse $ Ellipsis : $2 }  MacroParams :: { [StringNode] } MacroParams-:	MacroParam							{ [$1] }-|	MacroParams ',' MacroParam					{ $3 : $1 }+:	MacroParam						{ [$1] }+|	MacroParams ',' MacroParam				{ $3 : $1 }  MacroParam :: { StringNode } MacroParam-:	IdVar								{ MacroParam $1 }+:	IdVar							{ MacroParam $1 }  MacroBody :: { StringNode } MacroBody-:	do CompoundStmt while '(' LIT_INTEGER ')'			{% macroBodyStmt $2 $5 }-|	FunctionCall							{ MacroBodyFunCall $1 }+:	do CompoundStmt while '(' LIT_INTEGER ')'		{% macroBodyStmt $2 $5 }+|	FunctionCall						{ MacroBodyFunCall $1 }  ExternC :: { StringNode } ExternC@@ -304,368 +347,388 @@ 	ToplevelDecls 	'#ifdef' ID_CONST 	'}'-	'#endif'							{% externC $2 $4 $7 $9 }+	'#endif'						{% externC $2 $4 (reverse $7) $9 }  Stmts :: { [StringNode] } Stmts-:	Stmt								{ [$1] }-|	Stmts Stmt							{ $2 : $1 }+:	Stmt							{ [$1] }+|	Stmts Stmt						{ $2 : $1 }  Stmt :: { StringNode } Stmt-:	PreprocIfdef(Stmts)						{ $1 }-|	PreprocIf(Stmts)						{ $1 }-|	PreprocDefine Stmts PreprocUndef				{ PreprocScopedDefine $1 $2 $3 }-|	LabelStmt							{ $1 }-|	DeclStmt							{ $1 }-|	CompoundStmt							{ CompoundStmt $1 }-|	IfStmt								{ $1 }-|	ForStmt								{ $1 }-|	WhileStmt							{ $1 }-|	DoWhileStmt							{ $1 }-|	AssignExpr ';'							{ $1 }-|	ExprStmt ';'							{ $1 }-|	FunctionCall ';'						{ $1 }-|	break ';'							{ Break }-|	goto ID_CONST ';'						{ Goto $2 }-|	continue ';'							{ Continue }-|	return ';'							{ Return Nothing }-|	return Expr ';'							{ Return (Just $2) }-|	switch '(' Expr ')' CompoundStmt				{ Switch $3 $5 }-|	Comment								{ $1 }+:	PreprocIfdef(Stmts)					{ $1 }+|	PreprocIf(Stmts)					{ $1 }+|	PreprocDefine Stmts PreprocUndef			{ PreprocScopedDefine $1 $2 $3 }+|	LabelStmt						{ $1 }+|	DeclStmt						{ $1 }+|	CompoundStmt						{ CompoundStmt $1 }+|	IfStmt							{ $1 }+|	ForStmt							{ $1 }+|	WhileStmt						{ $1 }+|	DoWhileStmt						{ $1 }+|	AssignExpr ';'						{ $1 }+|	ExprStmt ';'						{ $1 }+|	FunctionCall ';'					{ $1 }+|	break ';'						{ Break }+|	goto ID_CONST ';'					{ Goto $2 }+|	continue ';'						{ Continue }+|	return ';'						{ Return Nothing }+|	return Expr ';'						{ Return (Just $2) }+|	switch '(' Expr ')' CompoundStmt			{ SwitchStmt $3 $5 }+|	Comment							{ $1 }  IfStmt :: { StringNode } IfStmt-:	if '(' Expr ')' CompoundStmt					{ IfStmt $3 $5 Nothing }-|	if '(' Expr ')' CompoundStmt else IfStmt			{ IfStmt $3 $5 (Just $7) }-|	if '(' Expr ')' CompoundStmt else CompoundStmt			{ IfStmt $3 $5 (Just (CompoundStmt $7)) }+:	if '(' Expr ')' CompoundStmt				{ IfStmt $3 $5 Nothing }+|	if '(' Expr ')' CompoundStmt else IfStmt		{ IfStmt $3 $5 (Just $7) }+|	if '(' Expr ')' CompoundStmt else CompoundStmt		{ IfStmt $3 $5 (Just (CompoundStmt $7)) }  ForStmt :: { StringNode } ForStmt-:	for '(' ForInit Opt(Expr) ';' Opt(ForNext) ')' CompoundStmt	{ ForStmt $3 $4 $6 $8 }+:	for '(' ForInit Expr ';' ForNext ')' CompoundStmt	{ ForStmt $3 $4 $6 $8 } -ForInit :: { Maybe (StringNode) }+ForInit :: { StringNode } ForInit-:	';'								{ Nothing }-|	AssignExpr ';'							{ Just $1 }-|	SingleVarDecl							{ Just $1 }+:	AssignExpr ';'						{ $1 }+|	VarDecl							{ $1 }  ForNext :: { StringNode } ForNext-:	ExprStmt							{ $1 }-|	AssignExpr							{ $1 }--Opt(x)-:									{ Nothing }-|	x								{ Just $1 }+:	ExprStmt						{ $1 }+|	AssignExpr						{ $1 }  WhileStmt :: { StringNode } WhileStmt-:	while '(' Expr ')' CompoundStmt					{ WhileStmt $3 $5 }+:	while '(' Expr ')' CompoundStmt				{ WhileStmt $3 $5 }  DoWhileStmt :: { StringNode } DoWhileStmt-:	do CompoundStmt while '(' Expr ')' ';'				{ DoWhileStmt $2 $5 }+:	do CompoundStmt while '(' Expr ')' ';'			{ DoWhileStmt $2 $5 }  LabelStmt :: { StringNode } LabelStmt-:	case Expr ':' Stmt						{ Case $2 $4 }-|	default ':' Stmt						{ Default $3 }-|	ID_CONST ':' Stmt						{ Label $1 $3 }+:	case Expr ':' AfterLabelStmt				{ Case $2 $4 }+|	default ':' AfterLabelStmt				{ Default $3 }+|	ID_CONST ':' Stmt					{ Label $1 $3 } +AfterLabelStmt :: { StringNode }+AfterLabelStmt+:	CompoundStmt						{ CompoundStmt $1 }+|	LabelStmt						{ $1 }+|	return Expr ';'						{ Return (Just $2) }+ DeclStmt :: { StringNode } DeclStmt-:	VarDecl								{ $1 }-|	VLA '(' Type ',' IdVar ',' Expr ')' ';'				{ VLA $3 $5 $7 }--SingleVarDecl :: { StringNode }-SingleVarDecl-:	QualType Declarator ';'						{ VarDecl $1 [$2] }+:	VarDecl							{ $1 }+|	VLA '(' QualType ',' IdVar ',' Expr ')' ';'		{ VLA $3 $5 $7 }  VarDecl :: { StringNode } VarDecl-:	QualType Declarators ';'					{ VarDecl $1 (reverse $2) }--Declarators :: { [StringNode] }-Declarators-:	Declarator							{ [$1] }-|	Declarators ',' Declarator					{ $3 : $1 }+:	QualType Declarator ';'					{ VarDecl $1 $2 }  Declarator :: { StringNode } Declarator-:	DeclSpec '=' InitialiserExpr					{ Declarator $1 (Just $3) }-|	DeclSpec							{ Declarator $1 Nothing }+:	DeclSpec '=' InitialiserExpr				{ Declarator $1 (Just $3) }+|	DeclSpec						{ Declarator $1 Nothing }  InitialiserExpr :: { StringNode } InitialiserExpr-:	InitialiserList							{ InitialiserList $1 }-|	Expr								{ $1 }+:	InitialiserList						{ InitialiserList $1 }+|	Expr							{ $1 }  DeclSpec :: { StringNode } DeclSpec-:	IdVar								{ DeclSpecVar $1 }-|	DeclSpec '[' ']'						{ DeclSpecArray $1 Nothing }-|	DeclSpec '[' Expr ']'						{ DeclSpecArray $1 (Just $3) }+:	IdVar							{ DeclSpecVar $1 }+|	DeclSpec '[' ']'					{ DeclSpecArray $1 Nothing }+|	DeclSpec '[' Expr ']'					{ DeclSpecArray $1 (Just $3) }  IdVar :: { Lexeme String } IdVar-:	ID_VAR								{ $1 }-|	default								{ $1 }-|	'error'								{ $1 }+:	ID_VAR							{ $1 }+|	default							{ $1 }+|	'error'							{ $1 }  InitialiserList :: { [StringNode] } InitialiserList-:	'{' Initialisers '}'						{ reverse $2 }-|	'{' Initialisers ',' '}'					{ reverse $2 }+:	'{' Initialisers '}'					{ reverse $2 }+|	'{' Initialisers ',' '}'				{ reverse $2 }  Initialisers :: { [StringNode] } Initialisers-:	Initialiser							{ [$1] }-|	Initialisers ',' Initialiser					{ $3 : $1 }+:	Initialiser						{ [$1] }+|	Initialisers ',' Initialiser				{ $3 : $1 }  Initialiser :: { StringNode } Initialiser-:	Expr								{ $1 }-|	InitialiserList							{ InitialiserList $1 }+:	Expr							{ $1 }+|	InitialiserList						{ InitialiserList $1 }  CompoundStmt :: { [StringNode] } CompoundStmt-:	'{' Stmts '}'							{ $2 }+:	'{' Stmts '}'						{ reverse $2 } +-- Expressions that are safe for use as macro body without () around it..+PreprocSafeExpr(x)+:	LiteralExpr						{ $1 }+|	'(' x ')'						{ ParenExpr $2 }+|	'(' QualType ')' x %prec CAST				{ CastExpr $2 $4 }+|	sizeof '(' x ')'					{ SizeofExpr $3 }+|	sizeof '(' QualType ')'					{ SizeofType $3 }++ConstExpr :: { StringNode }+ConstExpr+:	PureExpr(ConstExpr)					{ $1 }+ PureExpr(x)-:	x '!=' x							{ BinaryExpr $1 BopNe $3 }-|	x '==' x							{ BinaryExpr $1 BopEq $3 }-|	x '||' x							{ BinaryExpr $1 BopOr $3 }-|	x '^' x								{ BinaryExpr $1 BopBitXor $3 }-|	x '|' x								{ BinaryExpr $1 BopBitOr $3 }-|	x '&&' x							{ BinaryExpr $1 BopAnd $3 }-|	x '&' x								{ BinaryExpr $1 BopBitAnd $3 }-|	x '/' x								{ BinaryExpr $1 BopDiv $3 }-|	x '*' x								{ BinaryExpr $1 BopMul $3 }-|	x '%' x								{ BinaryExpr $1 BopMod $3 }-|	x '+' x								{ BinaryExpr $1 BopPlus $3 }-|	x '-' x								{ BinaryExpr $1 BopMinus $3 }-|	x '<' x								{ BinaryExpr $1 BopLt $3 }-|	x '<=' x							{ BinaryExpr $1 BopLe $3 }-|	x '<<' x							{ BinaryExpr $1 BopLsh $3 }-|	x '>' x								{ BinaryExpr $1 BopGt $3 }-|	x '>=' x							{ BinaryExpr $1 BopGe $3 }-|	x '>>' x							{ BinaryExpr $1 BopRsh $3 }-|	x '?' x ':' x							{ TernaryExpr $1 $3 $5 }-|	'(' x ')'							{ ParenExpr $2 }-|	'!' x								{ UnaryExpr UopNot $2 }-|	'~' x								{ UnaryExpr UopNeg $2 }-|	'-' x %prec NEG							{ UnaryExpr UopMinus $2 }-|	'&' x %prec ADDRESS						{ UnaryExpr UopAddress $2 }-|	'(' QualType ')' x %prec CAST					{ CastExpr $2 $4 }-|	sizeof '(' x ')'						{ SizeofExpr $3 }-|	sizeof '(' Type ')'						{ SizeofExpr $3 }+:	PreprocSafeExpr(x)					{ $1 }+|	x '!=' x						{ BinaryExpr $1 BopNe $3 }+|	x '==' x						{ BinaryExpr $1 BopEq $3 }+|	x '||' x						{ BinaryExpr $1 BopOr $3 }+|	x '^' x							{ BinaryExpr $1 BopBitXor $3 }+|	x '|' x							{ BinaryExpr $1 BopBitOr $3 }+|	x '&&' x						{ BinaryExpr $1 BopAnd $3 }+|	x '&' x							{ BinaryExpr $1 BopBitAnd $3 }+|	x '/' x							{ BinaryExpr $1 BopDiv $3 }+|	x '*' x							{ BinaryExpr $1 BopMul $3 }+|	x '%' x							{ BinaryExpr $1 BopMod $3 }+|	x '+' x							{ BinaryExpr $1 BopPlus $3 }+|	x '-' x							{ BinaryExpr $1 BopMinus $3 }+|	x '<' x							{ BinaryExpr $1 BopLt $3 }+|	x '<=' x						{ BinaryExpr $1 BopLe $3 }+|	x '<<' x						{ BinaryExpr $1 BopLsh $3 }+|	x '>' x							{ BinaryExpr $1 BopGt $3 }+|	x '>=' x						{ BinaryExpr $1 BopGe $3 }+|	x '>>' x						{ BinaryExpr $1 BopRsh $3 }+|	x '?' x ':' x						{ TernaryExpr $1 $3 $5 }+|	'!' x							{ UnaryExpr UopNot $2 }+|	'~' x							{ UnaryExpr UopNeg $2 }+|	'-' x %prec NEG						{ UnaryExpr UopMinus $2 }+|	'&' x %prec ADDRESS					{ UnaryExpr UopAddress $2 }  LiteralExpr :: { StringNode } LiteralExpr-:	LIT_CHAR							{ LiteralExpr Char $1 }-|	LIT_INTEGER							{ LiteralExpr Int $1 }-|	LIT_FALSE							{ LiteralExpr Bool $1 }-|	LIT_TRUE							{ LiteralExpr Bool $1 }-|	LIT_STRING							{ LiteralExpr String $1 }-|	ID_CONST							{ LiteralExpr ConstId $1 }+:	StringLiteralExpr					{ $1 }+|	LIT_CHAR						{ LiteralExpr Char $1 }+|	LIT_INTEGER						{ LiteralExpr Int $1 }+|	LIT_FALSE						{ LiteralExpr Bool $1 }+|	LIT_TRUE						{ LiteralExpr Bool $1 }+|	ID_CONST						{ LiteralExpr ConstId $1 } +StringLiteralExpr :: { StringNode }+StringLiteralExpr+:	LIT_STRING						{ LiteralExpr String $1 }+|	StringLiteralExpr LIT_STRING				{ $1 }++LhsExpr :: { StringNode }+LhsExpr+:	IdVar							{ VarExpr $1 }+|	'*' LhsExpr %prec DEREF					{ UnaryExpr UopDeref $2 }+|	LhsExpr '.' IdVar					{ MemberAccess $1 $3 }+|	LhsExpr '->' IdVar					{ PointerAccess $1 $3 }+|	LhsExpr '[' Expr ']'					{ ArrayAccess $1 $3 }+ Expr :: { StringNode } Expr-:	LhsExpr								{ $1 }-|	ExprStmt							{ $1 }-|	LiteralExpr							{ $1 }-|	FunctionCall							{ $1 }-|	PureExpr(Expr)							{ $1 }+:	LhsExpr							{ $1 }+|	ExprStmt						{ $1 }+|	FunctionCall						{ $1 }+|	PureExpr(Expr)						{ $1 }  AssignExpr :: { StringNode } AssignExpr-:	LhsExpr AssignOperator Expr					{ AssignExpr $1 $2 $3 }+:	LhsExpr AssignOperator Expr				{ AssignExpr $1 $2 $3 }  AssignOperator :: { AssignOp } AssignOperator-:	'='								{ AopEq      }-|	'*='								{ AopMul     }-|	'/='								{ AopDiv     }-|	'+='								{ AopPlus    }-|	'-='								{ AopMinus   }-|	'&='								{ AopBitAnd  }-|	'|='								{ AopBitOr   }-|	'^='								{ AopBitXor  }-|	'%='								{ AopMod     }-|	'<<='								{ AopLsh     }-|	'>>='								{ AopRsh     }+:	'='							{ AopEq      }+|	'*='							{ AopMul     }+|	'/='							{ AopDiv     }+|	'+='							{ AopPlus    }+|	'-='							{ AopMinus   }+|	'&='							{ AopBitAnd  }+|	'|='							{ AopBitOr   }+|	'^='							{ AopBitXor  }+|	'%='							{ AopMod     }+|	'<<='							{ AopLsh     }+|	'>>='							{ AopRsh     }  ExprStmt :: { StringNode } ExprStmt-:	'++' Expr							{ UnaryExpr UopIncr $2 }-|	'--' Expr							{ UnaryExpr UopDecr $2 }--LhsExpr :: { StringNode }-LhsExpr-:	IdVar								{ VarExpr $1 }-|	'*' LhsExpr %prec DEREF						{ UnaryExpr UopDeref $2 }-|	LhsExpr '.' IdVar						{ MemberAccess $1 $3 }-|	LhsExpr '->' IdVar						{ PointerAccess $1 $3 }-|	LhsExpr '[' Expr ']'						{ ArrayAccess $1 $3 }+:	'++' Expr						{ UnaryExpr UopIncr $2 }+|	'--' Expr						{ UnaryExpr UopDecr $2 }  FunctionCall :: { StringNode } FunctionCall-:	Expr ArgList							{ FunctionCall $1 $2 }+:	Expr ArgList						{ FunctionCall $1 $2 }  ArgList :: { [StringNode] } ArgList-:	'(' ')'								{ [] }-|	'(' Args ')'							{ reverse $2 }+:	'(' ')'							{ [] }+|	'(' Args ')'						{ reverse $2 }  Args :: { [StringNode] } Args-:	Arg								{ [$1] }-|	Args ',' Arg							{ $3 : $1 }+:	Arg							{ [$1] }+|	Args ',' Arg						{ $3 : $1 }  Arg :: { StringNode } Arg-:	Expr								{ $1 }-|	Comment Expr							{ CommentExpr $1 $2 }+:	Expr							{ $1 }+|	Comment Expr						{ CommentExpr $1 $2 }  EnumDecl :: { StringNode } EnumDecl-:	enum class ID_SUE_TYPE EnumeratorList				{ EnumClass $3 $4 }-|	enum       ID_SUE_TYPE EnumeratorList				{ EnumConsts (Just $2) $3 }-|	enum                   EnumeratorList ';'			{ EnumConsts Nothing $2 }-|	typedef enum ID_SUE_TYPE EnumeratorList ID_SUE_TYPE ';'		{ EnumDecl $3 $4 $5 }-|	bitmask ID_SUE_TYPE EnumeratorList				{ EnumDecl $2 $3 $2 }+:	enum class ID_SUE_TYPE EnumeratorList			{ EnumClass $3 $4 }+|	enum       ID_SUE_TYPE EnumeratorList			{ EnumConsts (Just $2) $3 }+|	enum                   EnumeratorList ';'		{ EnumConsts Nothing $2 }+|	typedef enum ID_SUE_TYPE EnumeratorList ID_SUE_TYPE ';'	{ EnumDecl $3 $4 $5 }+|	bitmask ID_SUE_TYPE EnumeratorList			{ EnumDecl $2 $3 $2 }  EnumeratorList :: { [StringNode] } EnumeratorList-:	'{' Enumerators '}'						{ $2 }+:	'{' Enumerators '}'					{ reverse $2 }  Enumerators :: { [StringNode] } Enumerators-:	Enumerator							{ [$1] }-|	Enumerators Enumerator						{ $2 : $1 }+:	Commented(Enumerator)					{ [$1] }+|	Enumerators Commented(Enumerator)			{ $2 : $1 } +Commented(x)+:	x							{ $1 }+|	DocComment x						{ Commented $1 $2 }+ Enumerator :: { StringNode } Enumerator-:	EnumeratorName ','						{ Enumerator $1 Nothing }-|	EnumeratorName '=' ConstExpr ','				{ Enumerator $1 (Just $3) }-|	namespace ID_CONST '{' Enumerators '}'				{ Namespace Global $2 $4 }-|	Comment								{ $1 }+:	EnumeratorName ','					{ Enumerator $1 Nothing }+|	EnumeratorName '=' ConstExpr ','			{ Enumerator $1 (Just $3) }+|	namespace ID_CONST '{' Enumerators '}'			{ Namespace Global $2 $4 }+|	Comment							{ $1 }  EnumeratorName :: { Lexeme String } EnumeratorName-:	ID_CONST							{ $1 }-|	ID_SUE_TYPE							{ $1 }+:	ID_CONST						{ $1 }+|	ID_SUE_TYPE						{ $1 }  AggregateDecl :: { StringNode } AggregateDecl-:	AggregateType ';'						{ $1 }-|	class ID_SUE_TYPE TypeParams ';'				{ ClassForward $2 $3 }-|	typedef AggregateType ID_SUE_TYPE ';'				{ Typedef $2 $3 }+:	AggregateType ';'					{ $1 }+|	class ID_SUE_TYPE TypeParams ';'			{ ClassForward $2 $3 }+|	typedef AggregateType ID_SUE_TYPE ';'			{ Typedef $2 $3 }  AggregateType :: { StringNode } AggregateType-:	struct ID_SUE_TYPE '{' MemberDecls '}'				{ Struct $2 $4 }-|	struct this '{' MemberDecls '}'					{ Struct $2 $4 }-|	union ID_SUE_TYPE '{' MemberDecls '}'				{ Union $2 $4 }+:	struct ID_SUE_TYPE '{' MemberDeclList '}'		{ Struct $2 $4 }+|	struct this '{' MemberDeclList '}'			{ Struct $2 $4 }+|	union ID_SUE_TYPE '{' MemberDeclList '}'		{ Union $2 $4 } +MemberDeclList :: { [StringNode] }+MemberDeclList+:	MemberDecls						{ reverse $1 }+ MemberDecls :: { [StringNode] } MemberDecls-:	MemberDecl							{ [$1] }-|	MemberDecls MemberDecl						{ $2 : $1 }+:	Commented(MemberDecl)					{ [$1] }+|	MemberDecls Commented(MemberDecl)			{ $2 : $1 }  MemberDecl :: { StringNode } MemberDecl-:	QualType DeclSpec ';'						{ MemberDecl $1 $2 Nothing }-|	QualType DeclSpec ':' LIT_INTEGER ';'				{ MemberDecl $1 $2 (Just $4) }-|	namespace IdVar '{' MemberDecls '}'				{ Namespace Global $2 $4 }-|	PreprocIfdef(MemberDecls)					{ $1 }-|	Comment								{ $1 }+:	QualType DeclSpec ';'					{ MemberDecl $1 $2 Nothing }+|	QualType DeclSpec ':' LIT_INTEGER ';'			{ MemberDecl $1 $2 (Just $4) }+|	namespace IdVar '{' MemberDeclList '}'			{ Namespace Global $2 $4 }+|	PreprocIfdef(MemberDeclList)				{ $1 }+|	Comment							{ $1 }  TypedefDecl :: { StringNode } TypedefDecl-:	typedef QualType ID_SUE_TYPE ';'				{ Typedef $2 $3 }-|	typedef FunctionPrototype(ID_FUNC_TYPE) ';'			{ TypedefFunction $2 }+:	typedef QualType ID_SUE_TYPE ';'			{ Typedef $2 $3 }+|	typedef FunctionPrototype(ID_FUNC_TYPE) ';'		{ TypedefFunction $2 }  QualType :: { StringNode } QualType-:	Type								{ $1 }-|	const Type							{ TyConst $2 }--Type :: { StringNode }-Type-:	LeafType							{ $1 }-|	Type '*'							{ TyPointer $1 }-|	Type const							{ TyConst $1 }+:	LeafType						{                               $1 }+|	LeafType '*'						{                     TyPointer $1 }+|	LeafType '*' '*'					{ TyPointer          (TyPointer $1) }+|	LeafType '*' const					{            TyConst (TyPointer $1) }+|	LeafType '*' const '*'					{ 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))) }+|	const LeafType						{                                TyConst $2 }+|	const LeafType '*'					{                     TyPointer (TyConst $2) }+|	const LeafType '*' const				{            TyConst (TyPointer (TyConst $2)) }+|	const LeafType '*' const '*'				{ TyPointer (TyConst (TyPointer (TyConst $2))) }  LeafType :: { StringNode } LeafType-:	struct ID_SUE_TYPE						{ TyStruct $2 }-|	void								{ TyStd $1 }-|	this								{ TyStd $1 }-|	ID_FUNC_TYPE							{ TyFunc $1 }-|	ID_STD_TYPE							{ TyStd $1 }-|	ID_SUE_TYPE							{ TyUserDefined $1 }-|	ID_TYVAR							{ TyVar $1 }+:	struct ID_SUE_TYPE					{ TyStruct $2 }+|	void							{ TyStd $1 }+|	this							{ TyStd $1 }+|	ID_FUNC_TYPE						{ TyFunc $1 }+|	ID_STD_TYPE						{ TyStd $1 }+|	ID_SUE_TYPE						{ TyUserDefined $1 }+|	ID_TYVAR						{ TyVar $1 }  FunctionDecl :: { StringNode } FunctionDecl-:	FunctionDeclarator						{ $1 Global }-|	static FunctionDeclarator					{ $2 Static }+:	FunctionDeclarator					{ $1 Global }+|	static FunctionDeclarator				{ $2 Static }  FunctionDeclarator :: { Scope -> StringNode } FunctionDeclarator-:	FunctionPrototype(IdVar) WithError				{ \s -> FunctionDecl s $1 $2 }-|	FunctionPrototype(IdVar) CompoundStmt				{ \s -> FunctionDefn s $1 $2 }-|	QualType DeclSpec '{' Accessors '}'				{ \s -> Property $1 $2 $4 }+:	FunctionPrototype(IdVar) WithError			{ \s -> FunctionDecl s $1 $2 }+|	FunctionPrototype(IdVar) CompoundStmt			{ \s -> FunctionDefn s $1 $2 }+|	QualType DeclSpec '{' Accessors '}'			{ \s -> Property $1 $2 (reverse $4) }  Accessors :: { [StringNode] } Accessors-:	Accessor							{ [$1] }-|	Accessors Accessor						{ $2 : $1 }+:	Accessor						{ [$1] }+|	Accessors Accessor					{ $2 : $1 }  Accessor :: { StringNode } Accessor-:	IdVar FunctionParamList WithError				{ Accessor $1 $2 $3 }-|	Comment								{ $1 }+:	IdVar FunctionParamList WithError			{ Accessor $1 $2 $3 }+|	Comment							{ $1 }  WithError :: { Maybe StringNode } WithError-:	';'								{ Nothing }-|	with 'error' EnumeratorList					{ Just (ErrorList $3) }-|	with 'error' for IdVar ';'					{ Just (ErrorFor $4) }+:	';'							{ Nothing }+|	with 'error' EnumeratorList				{ Just (ErrorList $3) }+|	with 'error' for IdVar ';'				{ Just (ErrorFor $4) }  FunctionPrototype(id)-:	QualType id FunctionParamList					{ FunctionPrototype $1 $2 $3 }-|	QualType id FunctionParamList const				{ FunctionPrototype $1 $2 $3 }+:	QualType id FunctionParamList				{ FunctionPrototype $1 $2 $3 }+|	QualType id FunctionParamList const			{ FunctionPrototype $1 $2 $3 }  FunctionParamList :: { [StringNode] } FunctionParamList-:	'(' ')'								{ [] }-|	'(' void ')'							{ [TyStd $2] }-|	'(' FunctionParams ')'						{ reverse $2 }-|	'(' FunctionParams ',' '...' ')'				{ reverse $ Ellipsis : $2 }+:	'(' ')'							{ [] }+|	'(' void ')'						{ [TyStd $2] }+|	'(' FunctionParams ')'					{ reverse $2 }+|	'(' FunctionParams ',' '...' ')'			{ reverse $ Ellipsis : $2 }  FunctionParams :: { [StringNode] } FunctionParams-:	FunctionParam							{ [$1] }-|	FunctionParams ',' FunctionParam				{ $3 : $1 }+:	FunctionParam						{ [$1] }+|	FunctionParams ',' FunctionParam			{ $3 : $1 }  FunctionParam :: { StringNode } FunctionParam-:	QualType DeclSpec						{ FunctionParam $1 $2 }+:	QualType DeclSpec					{ FunctionParam $1 $2 }  ConstDecl :: { StringNode } ConstDecl-:	extern const LeafType ID_VAR ';'				{ ConstDecl $3 $4 }-|	const LeafType ID_VAR '=' InitialiserExpr ';'			{ ConstDefn Global $2 $3 $5 }-|	static const LeafType ID_VAR '=' InitialiserExpr ';'		{ ConstDefn Static $3 $4 $6 }+:	extern const LeafType ID_VAR ';'			{ ConstDecl $3 $4 }+|	const LeafType ID_VAR '=' InitialiserExpr ';'		{ ConstDefn Global $2 $3 $5 }+|	static const LeafType ID_VAR '=' InitialiserExpr ';'	{ ConstDefn Static $3 $4 $6 }  {-type StringNode = Node (Lexeme String)+type StringLexeme = Lexeme String+type StringNode = Node StringLexeme -parseError :: Show text => Lexeme text -> Alex a-parseError token = alexError $ "Parse error near token: " <> show token+parseError :: Show text => (Lexeme text, [String]) -> Alex a+parseError (token, options) =+    alexError $ "Parse error near token: " <> show token <> "; expected one of " <> show options  lexwrap :: (Lexeme String -> Alex a) -> Alex a lexwrap = (alexMonadScan >>=)

@@ -0,0 +1,567 @@+module Language.Cimple.Pretty (ppTranslationUnit) where++import qualified Data.List                    as List+import           Data.Text                    (Text)+import qualified Data.Text                    as Text+import           Language.Cimple              (AssignOp (..), BinaryOp (..),+                                               CommentStyle (..), Lexeme (..),+                                               LexemeClass (..), Node (..),+                                               Scope (..), UnaryOp (..),+                                               lexemeText)+import           Prelude                      hiding ((<$>))+import           Text.Groom                   (groom)+import           Text.PrettyPrint.ANSI.Leijen++ppText :: Text -> Doc+ppText = text . Text.unpack++ppLexeme :: Lexeme Text -> Doc+ppLexeme = ppText . lexemeText++ppCommaSep :: (a -> Doc) -> [a] -> Doc+ppCommaSep go = foldr (<>) empty . List.intersperse (text ", ") . map go++ppLineSep :: (a -> Doc) -> [a] -> Doc+ppLineSep go = foldr (<>) empty . List.intersperse linebreak . map go++ppComment :: CommentStyle -> [Node (Lexeme Text)] -> Doc+ppComment style cs =+    nest 1 (ppCommentStyle style <> ppCommentBody cs) <+> text "*/"++ppCommentStyle :: CommentStyle -> Doc+ppCommentStyle Block   = text "/***"+ppCommentStyle Doxygen = text "/**"+ppCommentStyle Regular = text "/*"++ppCommentBody :: [Node (Lexeme Text)] -> Doc+ppCommentBody = go . map unCommentWord+  where+    unCommentWord (CommentWord l) = l+    unCommentWord x               = error $ groom x++    go (L _ LitInteger t1 : L _ PctMinus m : L _ LitInteger t2 : xs) =+        space <> ppText t1 <> ppText m <> ppText t2 <> go xs+    go (L _ PctMinus m : L _ LitInteger t : xs) =+        space <> ppText m <> ppText t <> go xs++    go (l : L _ PctPeriod t : xs) = go [l] <> ppText t <> go xs+    go (l : L _ PctComma  t : xs) = go [l] <> ppText t <> go xs+    go (x                   : xs) = ppWord x <> go xs+    go []                         = empty++    ppWord (L _ CmtSpdxLicense   t) = space <> ppText t+    ppWord (L _ CmtSpdxCopyright t) = space <> ppText t+    ppWord (L _ CmtWord          t) = space <> ppText t+    ppWord (L _ CmtCode          t) = space <> ppText t+    ppWord (L _ CmtRef           t) = space <> ppText t+    ppWord (L _ CmtIndent        _) = char '*'+    ppWord (L _ PpNewline        _) = linebreak+    ppWord (L _ LitInteger       t) = space <> ppText t+    ppWord (L _ LitString        t) = space <> ppText t+    ppWord (L _ PctEMark         t) = space <> ppText t+    ppWord (L _ PctPlus          t) = space <> ppText t+    ppWord (L _ PctEq            t) = space <> ppText t+    ppWord (L _ PctMinus         t) = space <> ppText t+    ppWord (L _ PctPeriod        t) = space <> ppText t+    ppWord (L _ PctLParen        t) = space <> ppText t+    ppWord (L _ PctRParen        t) = space <> ppText t+    ppWord (L _ PctSemicolon     t) = space <> ppText t+    ppWord (L _ PctColon         t) = space <> ppText t+    ppWord (L _ PctQMark         t) = space <> ppText t+    ppWord (L _ PctSlash         t) = space <> ppText t+    ppWord (L _ PctGreater       t) = space <> ppText t+    ppWord (L _ PctLess          t) = space <> ppText t+    ppWord (L _ PctComma         t) = space <> ppText t+    ppWord x                        = error $ groom x++ppScope :: Scope -> Doc+ppScope Global = empty+ppScope Static = text "static "++ppType :: Node (Lexeme Text) -> Doc+ppType (TyPointer     ty) = ppType ty <> char '*'+ppType (TyConst       ty) = ppType ty <+> text "const"+ppType (TyUserDefined l ) = ppLexeme l+ppType (TyStd         l ) = ppLexeme l+ppType (TyFunc        l ) = ppLexeme l+ppType (TyStruct      l ) = text "struct" <+> ppLexeme l+ppType (TyVar         l ) = ppLexeme l+ppType x                  = error . groom $ x++ppAssignOp :: AssignOp -> Doc+ppAssignOp op = case op of+    AopEq     -> text "="+    AopMul    -> text "*="+    AopDiv    -> text "/="+    AopPlus   -> text "+="+    AopMinus  -> text "-="+    AopBitAnd -> text "&="+    AopBitOr  -> text "|="+    AopBitXor -> text "^="+    AopMod    -> text "%="+    AopLsh    -> text ">>="+    AopRsh    -> text "<<="++ppBinaryOp :: BinaryOp -> Doc+ppBinaryOp op = case op of+    BopNe     -> text "!="+    BopEq     -> text "=="+    BopOr     -> text "||"+    BopBitXor -> char '^'+    BopBitOr  -> char '|'+    BopAnd    -> text "&&"+    BopBitAnd -> char '&'+    BopDiv    -> char '/'+    BopMul    -> char '*'+    BopMod    -> char '%'+    BopPlus   -> char '+'+    BopMinus  -> char '-'+    BopLt     -> char '<'+    BopLe     -> text "<="+    BopLsh    -> text "<<"+    BopGt     -> char '>'+    BopGe     -> text ">="+    BopRsh    -> text ">>"++ppUnaryOp :: UnaryOp -> Doc+ppUnaryOp op = case op of+    UopNot     -> char '!'+    UopNeg     -> char '~'+    UopMinus   -> char '-'+    UopAddress -> char '&'+    UopDeref   -> char '*'+    UopIncr    -> text "++"+    UopDecr    -> text "--"++ppInitialiserList :: [Node (Lexeme Text)] -> Doc+ppInitialiserList l = char '{' <+> ppCommaSep ppExpr l <+> char '}'++ppDeclSpec :: Node (Lexeme Text) -> Doc+ppDeclSpec (DeclSpecVar var        ) = ppLexeme var+ppDeclSpec (DeclSpecArray dspec dim) = ppDeclSpec dspec <> ppDim dim+  where+    ppDim Nothing  = text "[]"+    ppDim (Just x) = char '[' <> ppExpr x <> char ']'+ppDeclSpec x = error $ groom x++ppDeclarator :: Node (Lexeme Text) -> Doc+ppDeclarator (Declarator dspec Nothing) =+    ppDeclSpec dspec+ppDeclarator (Declarator dspec (Just initr)) =+    ppDeclSpec dspec <+> char '=' <+> ppExpr initr+ppDeclarator x = error $ groom x++ppFunctionParamList :: [Node (Lexeme Text)] -> Doc+ppFunctionParamList xs = char '(' <> ppCommaSep go xs <> char ')'+  where+    go (TyStd l@(L _ KwVoid _)) = ppLexeme l+    go (FunctionParam ty dspec) = ppType ty <+> ppDeclSpec dspec+    go Ellipsis                 = text "..."+    go x                        = error $ groom x++ppFunctionPrototype+    :: Node (Lexeme Text)+    -> Lexeme Text+    -> [Node (Lexeme Text)]+    -> Doc+ppFunctionPrototype ty name params =+    ppType ty <+> ppLexeme name <> ppFunctionParamList params++ppWithError :: Maybe (Node (Lexeme Text)) -> Doc+ppWithError Nothing = char ';'+ppWithError (Just (ErrorFor name)) =+    text " with error for" <+> ppLexeme name <> char ';'+ppWithError (Just (ErrorList errs)) =+    nest 2 (+        text " with error" <+> char '{' <$>+        ppEnumeratorList errs+    ) <$> char '}'+ppWithError x = error $ groom x++ppFunctionCall :: Node (Lexeme Text) -> [Node (Lexeme Text)] -> Doc+ppFunctionCall callee args =+    ppExpr callee <> char '(' <> ppCommaSep ppExpr args <> char ')'++ppMacroBody :: Node (Lexeme Text) -> Doc+ppMacroBody (MacroBodyFunCall e@FunctionCall{}) = ppExpr e+ppMacroBody (MacroBodyStmt body) =+    nest 2 (+        text "do {" <$>+        ppStmtList body+    ) <$> text "} while (0)"+ppMacroBody x                                   = error $ groom x++ppMacroParam :: Node (Lexeme Text) -> Doc+ppMacroParam (MacroParam l) = ppLexeme l+ppMacroParam Ellipsis       = text "..."+ppMacroParam x              = error $ groom x++ppMacroParamList :: [Node (Lexeme Text)] -> Doc+ppMacroParamList xs = char '(' <> ppCommaSep ppMacroParam xs <> char ')'++ppNamespace :: ([a] -> Doc) -> Scope -> Lexeme Text -> [a] -> Doc+ppNamespace pp scope name members =+    nest 2 (+        ppScope scope <>+        text "namespace" <+> ppLexeme name <+> char '{' <$>+        pp members+    ) <$> char '}'++ppEnumerator :: Node (Lexeme Text) -> Doc+ppEnumerator (Comment    style _ cs _ ) = ppComment style cs+ppEnumerator (Enumerator name  Nothing) = ppLexeme name <> char ','+ppEnumerator (Enumerator name (Just value)) =+    ppLexeme name <+> char '=' <+> ppExpr value <> char ','+ppEnumerator (Namespace scope name members) =+    ppNamespace ppEnumeratorList scope name members+ppEnumerator x = error $ groom x++ppEnumeratorList :: [Node (Lexeme Text)] -> Doc+ppEnumeratorList = ppLineSep ppEnumerator++ppMemberDecl :: Node (Lexeme Text) -> Doc+ppMemberDecl = ppDecl++ppMemberDeclList :: [Node (Lexeme Text)] -> Doc+ppMemberDeclList = ppLineSep ppMemberDecl++ppAccessor :: Node (Lexeme Text) -> Doc+ppAccessor (Comment style _ cs _) = ppComment style cs+ppAccessor (Accessor name params errs) =+    ppLexeme name <> ppFunctionParamList params <> ppWithError errs+ppAccessor x = error $ groom x++ppAccessorList :: [Node (Lexeme Text)] -> Doc+ppAccessorList = ppLineSep ppAccessor++ppEventType :: Node (Lexeme Text) -> Doc+ppEventType (Commented (Comment style _ cs _) ty) =+    ppComment style cs <$> ppEventType ty+ppEventType (EventParams params) =+    text "typedef void" <> ppFunctionParamList params+ppEventType x = error $ groom x++ppTypeParams :: [Node (Lexeme Text)] -> Doc+ppTypeParams [] = empty+ppTypeParams xs = char '<' <> ppCommaSep pp xs <> char '>'+  where+    pp (TyVar x) = ppLexeme x+    pp x         = error $ groom x++ppCompoundStmt :: [Node (Lexeme Text)] -> Doc+ppCompoundStmt body =+    nest 2 (+        char '{' <$>+        ppStmtList body+    ) <$> char '}'++ppStmtList :: [Node (Lexeme Text)] -> Doc+ppStmtList = ppLineSep ppDecl++ppIfStmt+    :: Node (Lexeme Text)+    -> [Node (Lexeme Text)]+    -> Maybe (Node (Lexeme Text))+    -> Doc+ppIfStmt cond t Nothing =+    nest 2 (+        text "if (" <> ppExpr cond <> text ") {" <$>+        ppStmtList t+    ) <$> char '}'+ppIfStmt cond t (Just e) =+    nest 2 (+        text "if (" <> ppExpr cond <> text ") {" <$>+        ppStmtList t+    ) <$> nest 2 (char '}' <> text " else " <> ppDecl e)++ppForStmt+    :: Node (Lexeme Text)+    -> Node (Lexeme Text)+    -> Node (Lexeme Text)+    -> [Node (Lexeme Text)]+    -> Doc+ppForStmt i c n body =+    nest 2 (+        text "for ("+        <> ppDecl i+        <+> ppExpr c <> char ';'+        <+> ppExpr n+        <> text ") {" <$>+        ppStmtList body+    ) <$> char '}'++ppWhileStmt+    :: Node (Lexeme Text)+    -> [Node (Lexeme Text)]+    -> Doc+ppWhileStmt c body =+    nest 2 (+        text "while ("+        <> ppExpr c+        <> text ") {" <$>+        ppStmtList body+    ) <$> char '}'++ppDoWhileStmt+    :: [Node (Lexeme Text)]+    -> Node (Lexeme Text)+    -> Doc+ppDoWhileStmt body c =+    nest 2 (+        text "do ("+        <> text ") {" <$>+        ppStmtList body+    ) <$> text "} while (" <> ppExpr c <> char ')'++ppSwitchStmt+    :: Node (Lexeme Text)+    -> [Node (Lexeme Text)]+    -> Doc+ppSwitchStmt c body =+    nest 2 (+        text "switch ("+        <> ppExpr c+        <> text ") {" <$>+        ppStmtList body+    ) <$> char '}'++ppExpr :: Node (Lexeme Text) -> Doc+ppExpr expr = case expr of+    -- Expressions+    VarExpr var       -> ppLexeme var+    LiteralExpr _ l   -> ppLexeme l+    SizeofExpr arg    -> text "sizeof(" <> ppExpr arg <> char ')'+    SizeofType arg    -> text "sizeof(" <> ppType arg <> char ')'+    BinaryExpr  l o r -> ppExpr l <+> ppBinaryOp o <+> ppExpr r+    AssignExpr  l o r -> ppExpr l <+> ppAssignOp o <+> ppExpr r+    TernaryExpr c t e -> ppTernaryExpr c t e+    UnaryExpr o e     -> ppUnaryOp o <> ppExpr e+    ParenExpr e       -> char '(' <> ppExpr e <> char ')'+    FunctionCall c  a -> ppFunctionCall c a+    ArrayAccess  e  i -> ppExpr e <> char '[' <> ppExpr i <> char ']'+    CastExpr     ty e -> char '(' <> ppType ty <> char ')' <> ppExpr e+    PreprocDefined  n -> text "defined(" <> ppLexeme n <> char ')'+    InitialiserList l -> ppInitialiserList l+    PointerAccess e m -> ppExpr e <> text "->" <> ppLexeme m+    MemberAccess  e m -> ppExpr e <> text "." <> ppLexeme m+    CommentExpr   c e -> ppCommentExpr c e++    x                 -> error $ groom x++ppTernaryExpr+    :: Node (Lexeme Text) -> Node (Lexeme Text) -> Node (Lexeme Text) -> Doc+ppTernaryExpr c t e =+    ppExpr c <+> char '?' <+> ppExpr t <+> char ':' <+> ppExpr e++ppCommentExpr :: Node (Lexeme Text) -> Node (Lexeme Text) -> Doc+ppCommentExpr (Comment style _ body _) e =+    ppCommentStyle style <+> ppCommentBody body <+> text "*/" <+> ppExpr e+ppCommentExpr c _ = error $ groom c++ppStmt :: Node (Lexeme Text) -> Doc+ppStmt = ppDecl++ppDeclList :: [Node (Lexeme Text)] -> Doc+ppDeclList = ppLineSep ppDecl++ppDecl :: Node (Lexeme Text) -> Doc+ppDecl decl = case decl of+    PreprocElif cond decls (PreprocElse []) ->+        text "#elif" <+> ppExpr cond <$>+        ppDeclList decls <$>+        text "#endif"+    PreprocElif cond decls elseBranch ->+        text "#elif" <+> ppExpr cond <$>+        ppDeclList decls <$>+        ppDeclList [elseBranch] <$>+        text "#endif"+    PreprocIf cond decls (PreprocElse []) ->+        nest (-100) (text "#if") <+> ppExpr cond <$>+        ppDeclList decls <$>+        text "#endif"+    PreprocIf cond decls elseBranch ->+        text "#if" <+> ppExpr cond <$>+        ppDeclList decls <$>+        ppDeclList [elseBranch] <$>+        text "#endif"+    PreprocIfdef name decls (PreprocElse []) ->+        indent (-2) (text "#ifndef" <+> ppLexeme name <$>+        ppDeclList decls) <$>+        text "#endif"+    PreprocIfdef name decls elseBranch ->+        text "#ifdef" <+> ppLexeme name <$>+        ppDeclList decls <$>+        ppDeclList [elseBranch] <$>+        text "#endif"+    PreprocIfndef name decls (PreprocElse []) ->+        text "#ifndef" <+> ppLexeme name <$>+        ppDeclList decls <$>+        text "#endif"+    PreprocIfndef name decls elseBranch ->+        text "#ifndef" <+> ppLexeme name <$>+        ppDeclList decls <$>+        ppDeclList [elseBranch] <$>+        text "#endif"+    PreprocElse decls ->+        text "#else" <$>+        ppDeclList decls++    PreprocScopedDefine def stmts undef ->+        ppDecl def <$> ppStmtList stmts <$> ppDecl undef++    PreprocInclude hdr ->+        text "#include" <+> ppLexeme hdr+    PreprocDefine name ->+        text "#define" <+> ppLexeme name+    PreprocDefineConst name value ->+        text "#define" <+> ppLexeme name <+> ppExpr value+    PreprocDefineMacro name params body ->+        text "#define" <+> ppLexeme name <> ppMacroParamList params <+> ppMacroBody body+    PreprocUndef name ->+        text "#undef" <+> ppLexeme name++    StaticAssert cond msg ->+        text "static_assert" <+> ppExpr cond <> char ',' <+> ppLexeme msg <> text ");"++    Comment style _ cs _ ->+        ppComment style cs+    CommentBlock cs ->+        ppLexeme cs+    Commented c d ->+        ppDecl c <$> ppDecl d++    ClassForward name [] ->+        text "class" <+> ppLexeme name <> char ';'+    Class scope name tyvars decls ->+        ppScope scope <>+        nest 2 (+            text "class" <+> ppLexeme name <> ppTypeParams tyvars <+> char '{' <$>+            ppDeclList decls+        ) <$> text "};"++    EnumConsts Nothing enums ->+        nest 2 (+            text "enum" <+> char '{' <$>+            ppEnumeratorList enums+        ) <$> text "};"+    EnumConsts (Just name) enums ->+        nest 2 (+            text "enum" <+> ppLexeme name <+> char '{' <$>+            ppEnumeratorList enums+        ) <$> text "};"+    EnumClass name enums ->+        nest 2 (+            text "enum class" <+> ppLexeme name <+> char '{' <$>+            ppEnumeratorList enums+        ) <$> text "};"+    EnumDecl name enums ty ->+        nest 2 (+            text "typedef enum" <+> ppLexeme name <+> char '{' <$>+            ppEnumeratorList enums+        ) <$> text "} " <> ppLexeme ty <> char ';'++    Namespace scope name decls ->+        ppNamespace ppDeclList scope name decls++    ExternC decls ->+        text "#ifndef __cplusplus" <$>+        text "extern \"C\" {" <$>+        text "#endif" <$>+        ppDeclList decls <$>+        text "#ifndef __cplusplus" <$>+        text "}" <$>+        text "#endif"++    Struct name members ->+        nest 2 (+            text "struct" <+> ppLexeme name <+> char '{' <$>+            ppMemberDeclList members+        ) <$> text "};"+    Typedef (Union name members) tyname ->+        nest 2 (+            text "typedef union" <+> ppLexeme name <+> char '{' <$>+            ppMemberDeclList members+        ) <$> char '}' <+> ppLexeme tyname <> char ';'+    Typedef (Struct name members) tyname ->+        nest 2 (+            text "typedef struct" <+> ppLexeme name <+> char '{' <$>+            ppMemberDeclList members+        ) <$> char '}' <+> ppLexeme tyname <> char ';'+    Typedef ty name ->+        text "typedef" <+> ppType ty <+> ppLexeme name <> char ';'+    TypedefFunction (FunctionPrototype ty name params) ->+        text "typedef" <+>+        ppFunctionPrototype ty name params <>+        char ';'++    MemberDecl ty dspec Nothing ->+        ppType ty <+> ppDeclSpec dspec <> char ';'+    MemberDecl ty dspec (Just size) ->+        ppType ty <+> ppDeclSpec dspec <+> char ':' <+> ppLexeme size <> char ';'++    FunctionDecl scope (FunctionPrototype ty name params) err ->+        ppScope scope <>+        ppFunctionPrototype ty name params <>+        ppWithError err+    FunctionDefn scope (FunctionPrototype ty name params) body ->+        ppScope scope <>+        ppFunctionPrototype ty name params <$>+        ppCompoundStmt body++    ConstDecl ty name ->+        text "extern const" <+> ppType ty <+> ppLexeme name <> char ';'+    ConstDefn scope ty name value ->+        ppScope scope <>+        ppType ty <+> ppLexeme name <+> char '=' <+> ppExpr value <> char ';'++    Event name ty ->+        nest 2 (+            text "event" <+> ppLexeme name <+> char '{' <$>+            ppEventType ty+        ) <$> char '}'++    Property ty dspec accessors ->+        nest 2 (+            ppType ty <+> ppDeclSpec dspec <+> char '{' <$>+            ppAccessorList accessors+        ) <$> char '}'++    ErrorDecl name errs ->+        nest 2 (+            text "error for" <+> ppLexeme name <+> char '{' <$>+            ppEnumeratorList errs+        ) <$> char '}'++    -- Statements+    Continue              -> text "continue;"+    Break                 -> text "break;"+    Return Nothing        -> text "return;"+    Return (Just e)       -> text "return" <+> ppExpr e <> char ';'+    VarDecl ty declr      -> ppType ty <+> ppDeclarator declr <> char ';'+    IfStmt cond t e       -> ppIfStmt cond t e+    ForStmt i c n body    -> ppForStmt i c n body+    Default s             -> text "default:" <+> ppStmt s+    Label l s             -> ppLexeme l <> char ':' <$> ppStmt s+    Goto l                -> text "goto " <> ppLexeme l <> char ';'+    Case        e    s    -> text "case " <> ppExpr e <> char ':' <+> ppStmt s+    WhileStmt   c    body -> ppWhileStmt c body+    DoWhileStmt body c    -> ppDoWhileStmt body c+    SwitchStmt  c    body -> ppSwitchStmt c body+    CompoundStmt body     -> char '{' <$> ppStmtList body <$> char '}'+    VLA ty n sz           -> ppVLA ty n sz++    x                     -> ppExpr x <> char ';'+++ppVLA :: Node (Lexeme Text) -> Lexeme Text -> Node (Lexeme Text) -> Doc+ppVLA ty n sz =+    text "VLA("+        <> ppType ty+        <> text ", "+        <> ppLexeme n+        <> text ", "+        <> ppExpr sz+        <> text ");"++ppTranslationUnit :: [Node (Lexeme Text)] -> Doc+ppTranslationUnit decls = ppDeclList decls <> linebreak

@@ -0,0 +1,43 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData      #-}+module Language.Cimple.Program+  ( Program+  , fromList+  , toList+  , includeGraph+  ) where++import           Data.Map.Strict                   (Map)+import qualified Data.Map.Strict                   as Map+import           Data.Text                         (Text)+import           Language.Cimple.AST               (Node (..))+import           Language.Cimple.Graph             (Graph)+import qualified Language.Cimple.Graph             as Graph+import           Language.Cimple.Lexer             (Lexeme (..))+import           Language.Cimple.SemCheck.Includes (collectIncludes,+                                                    normaliseIncludes)+import           Language.Cimple.TranslationUnit   (TranslationUnit)+++data Program a = Program+  { progAsts     :: Map FilePath [Node (Lexeme a)]+  , progIncludes :: Graph () FilePath+  }+++toList :: Program a -> [TranslationUnit a]+toList = Map.toList . progAsts+++includeGraph :: Program a -> [(FilePath, FilePath)]+includeGraph = Graph.edges . progIncludes+++fromList :: [TranslationUnit Text] -> Either String (Program Text)+fromList tus = do+    let tusWithIncludes = map normaliseIncludes tus+    let progAsts = Map.fromList . map fst $ tusWithIncludes+    -- Check whether all includes can be resolved.+    includeEdges <- mapM (uncurry $ collectIncludes $ map fst tus) tusWithIncludes+    let progIncludes = Graph.fromEdges includeEdges+    return Program{..}

@@ -0,0 +1,59 @@+{-# LANGUAGE StrictData #-}+module Language.Cimple.SemCheck.Includes+  ( collectIncludes+  , normaliseIncludes+  ) where++import           Control.Monad.State.Lazy        (State)+import qualified Control.Monad.State.Lazy        as State+import           Data.Text                       (Text)+import qualified Data.Text                       as Text+import           Language.Cimple.AST             (Node (..))+import           Language.Cimple.Lexer           (Lexeme (..))+import           Language.Cimple.Tokens          (LexemeClass (..))+import           Language.Cimple.TranslationUnit (TranslationUnit)+import           Language.Cimple.TraverseAst     (AstActions (..),+                                                  defaultActions, traverseAst)+import           System.FilePath                 (joinPath, splitPath,+                                                  takeDirectory)++collectIncludes+  :: [FilePath]+  -> TranslationUnit Text+  -> [FilePath]+  -> Either String ((), FilePath, [FilePath])+collectIncludes sources (file, _) includes =+    case filter (not . (`elem` sources)) includes of+        []        -> Right ((), file, includes)+        missing:_ -> Left $ file <> " includes missing " <> missing+++relativeTo :: FilePath -> FilePath -> FilePath+relativeTo "." file = file+relativeTo dir file = go (splitPath dir) (splitPath file)+  where+    go d ("../":f) = go (init d) f+    go d f         = joinPath (d ++ f)+++normaliseIncludes :: TranslationUnit Text -> (TranslationUnit Text, [FilePath])+normaliseIncludes (file, ast) =+    ((file, ast'), includes)+  where+    (ast', includes) = State.runState (traverseAst (go (takeDirectory file)) ast) []++    go :: FilePath -> AstActions (State [FilePath]) Text+    go dir = defaultActions+        { doNode = \node act ->+            case node of+                PreprocInclude (L spos LitString include) -> do+                    let includePath = relativeTo dir $ tread include+                    State.modify (includePath :)+                    return $ PreprocInclude (L spos LitString (tshow includePath))++                _ -> act+        }++      where+        tshow = Text.pack . show+        tread = read . Text.unpack

@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StrictData    #-} module Language.Cimple.Tokens     ( LexemeClass (..)     ) where@@ -33,6 +34,7 @@     | KwReturn     | KwSizeof     | KwStatic+    | KwStaticAssert     | KwStruct     | KwSwitch     | KwThis@@ -99,7 +101,6 @@     | PpElif     | PpElse     | PpEndif-    | PpError     | PpIf     | PpIfdef     | PpIfndef@@ -107,7 +108,10 @@     | PpNewline     | PpUndef     | CmtBlock+    | CmtIndent     | CmtStart+    | CmtStartBlock+    | CmtStartDoc     | CmtSpdxCopyright     | CmtSpdxLicense     | CmtCode

@@ -0,0 +1,9 @@+{-# LANGUAGE StrictData #-}+module Language.Cimple.TranslationUnit+  ( TranslationUnit+  ) where++import           Language.Cimple.AST   (Node)+import           Language.Cimple.Lexer (Lexeme)++type TranslationUnit a = (FilePath, [Node (Lexeme a)])

@@ -2,6 +2,7 @@ {-# LANGUAGE InstanceSigs        #-} {-# LANGUAGE LambdaCase          #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData          #-} module Language.Cimple.TraverseAst     ( TraverseAst (..)     , AstActions (..)@@ -16,10 +17,11 @@     traverseAst :: Applicative f => AstActions f Text -> a -> f a  data AstActions f text = AstActions-    { doNodes  :: [Node (Lexeme text)] -> f [Node (Lexeme text)] -> f [Node (Lexeme text)]-    , doNode   ::  Node (Lexeme text)  -> f (Node (Lexeme text)) -> f (Node (Lexeme text))-    , doLexeme ::        Lexeme text   -> f       (Lexeme text)  -> f       (Lexeme text)-    , doText   ::               text   -> f               text   -> f               text+    { doNodes   :: [Node (Lexeme text)] -> f [Node (Lexeme text)] -> f [Node (Lexeme text)]+    , doNode    ::  Node (Lexeme text)  -> f (Node (Lexeme text)) -> f (Node (Lexeme text))+    , doLexemes ::       [Lexeme text]  -> f       [Lexeme text]  -> f       [Lexeme text]+    , doLexeme  ::        Lexeme text   -> f       (Lexeme text)  -> f       (Lexeme text)+    , doText    ::               text   -> f               text   -> f               text     }  instance TraverseAst a => TraverseAst (Maybe a) where@@ -28,10 +30,11 @@  defaultActions :: Applicative f => AstActions f lexeme defaultActions = AstActions-    { doNodes  = const id-    , doNode   = const id-    , doLexeme = const id-    , doText   = const id+    { doNodes   = const id+    , doNode    = const id+    , doLexeme  = const id+    , doLexemes = const id+    , doText    = const id     }  instance TraverseAst Text where@@ -48,6 +51,10 @@         recurse :: TraverseAst a => a -> f a         recurse = traverseAst astActions +instance TraverseAst [Lexeme Text] where+    traverseAst astActions = doLexemes astActions <*>+        traverse (traverseAst astActions)+ instance TraverseAst (Node (Lexeme Text)) where     traverseAst :: forall f . Applicative f                 => AstActions f Text -> Node (Lexeme Text) -> f (Node (Lexeme Text))@@ -70,8 +77,6 @@             PreprocElse <$> recurse decls         PreprocElif cond decls elseBranch ->             PreprocElif <$> recurse cond <*> recurse decls <*> recurse elseBranch-        PreprocError msg ->-            PreprocError <$> recurse msg         PreprocUndef name ->             PreprocUndef <$> recurse name         PreprocDefined name ->@@ -84,8 +89,14 @@             MacroBodyFunCall <$> recurse expr         MacroParam name ->             MacroParam <$> recurse name-        Comment contents ->-            Comment <$> recurse contents+        StaticAssert cond msg ->+            StaticAssert <$> recurse cond <*> recurse msg+        LicenseDecl license copyrights ->+            LicenseDecl <$> recurse license <*> recurse copyrights+        CopyrightDecl from to owner ->+            CopyrightDecl <$> recurse from <*> recurse to <*> recurse owner+        Comment doc start contents end ->+            Comment doc <$> recurse start <*> recurse contents <*> recurse end         CommentBlock comment ->             CommentBlock <$> recurse comment         CommentWord word ->@@ -104,8 +115,8 @@             pure Continue         Return value ->             Return <$> recurse value-        Switch value cases ->-            Switch <$> recurse value <*> recurse cases+        SwitchStmt value cases ->+            SwitchStmt <$> recurse value <*> recurse cases         IfStmt cond thenStmts elseStmt ->             IfStmt <$> recurse cond <*> recurse thenStmts <*> recurse elseStmt         ForStmt initStmt cond next stmts ->@@ -122,8 +133,8 @@             Label <$> recurse label <*> recurse stmt         VLA ty name size ->             VLA <$> recurse ty <*> recurse name <*> recurse size-        VarDecl ty decls ->-            VarDecl <$> recurse ty <*> recurse decls+        VarDecl ty decl ->+            VarDecl <$> recurse ty <*> recurse decl         Declarator spec value ->             Declarator <$> recurse spec <*> recurse value         DeclSpecVar name ->@@ -146,6 +157,8 @@             CastExpr <$> recurse ty <*> recurse expr         SizeofExpr expr ->             SizeofExpr <$> recurse expr+        SizeofType ty ->+            SizeofType <$> recurse ty         LiteralExpr ty value ->             LiteralExpr ty <$> recurse value         VarExpr name ->

@@ -0,0 +1,119 @@+module Language.Cimple.PrettySpec where++import           Test.Hspec                   (Spec, describe, it, shouldBe)++import qualified Data.Text                    as Text+import           Language.Cimple.IO           (parseText)+import           Language.Cimple.Pretty       (ppTranslationUnit)+import           Text.PrettyPrint.ANSI.Leijen (displayS, renderCompact)++getRight :: Either String a -> a+getRight (Left  err) = error err+getRight (Right ok ) = ok++pretty :: String -> String+pretty =+    show+    . ppTranslationUnit+    . getRight+    . parseText+    . Text.pack++compact :: String -> String+compact =+    flip displayS ""+    . renderCompact+    . ppTranslationUnit+    . getRight+    . parseText+    . Text.pack+++spec :: Spec+spec = do+    describe "renderPretty" $ do+        it "pretty-prints a simple C function" $ do+            let pp = pretty "int a(void) { return 3; }"+            pp `shouldBe` unlines+                [ "int a(void)"+                , "{"+                , "  return 3;"+                , "}"+                ]++        it "pretty-prints a typedef struct" $ do+            let pp = pretty "typedef struct Foo { int32_t x; } Foo;"+            pp `shouldBe` unlines+                [ "typedef struct Foo {"+                , "  int32_t x;"+                , "} Foo;"+                ]++    describe "renderCompact" $ do+        it "pretty-prints a simple C function" $ do+            let pp = compact "int a(void) { return 3; }"+            pp `shouldBe` unlines+                [ "int a(void)"+                , "{"+                , "return 3;"+                , "}"+                ]++        it "pretty-prints a typedef struct" $ do+            let pp = compact "typedef struct Foo { int32_t x; } Foo;"+            pp `shouldBe` unlines+                [ "typedef struct Foo {"+                , "int32_t x;"+                , "} Foo;"+                ]++        it "respects newlines at end of comments" $ do+            compact "/* foo bar */" `shouldBe` "/* foo bar */\n"+            compact "/* foo bar\n */" `shouldBe` "/* foo bar\n */\n"++        it "respects comment styles" $ do+            compact "/* foo bar */" `shouldBe` "/* foo bar */\n"+            compact "/** foo bar */ int a(void);" `shouldBe` "/** foo bar */\nint a(void);\n"+            compact "/*** foo bar */" `shouldBe` "/*** foo bar */\n"+            compact "/**** foo bar */" `shouldBe` "/*** foo bar */\n"++        it "supports punctuation in comments" $ do+            compact "/* foo.bar,baz-blep */"+                `shouldBe` "/* foo. bar, baz - blep */\n"+            compact "/* foo? */" `shouldBe` "/* foo ? */\n"++        it "formats number ranges and negative numbers without spacing" $ do+            compact "/* 123 - 456 */" `shouldBe` "/* 123-456 */\n"+            compact "/* - 3 */" `shouldBe` "/* -3 */\n"+            compact "/* a-b */" `shouldBe` "/* a - b */\n"++        it "formats pointer types with east-const" $ do+            compact "void foo(const int *a);"+                `shouldBe` "void foo(int const* a);\n"+            compact "void foo(int const *a);"+                `shouldBe` "void foo(int const* a);\n"++        it "supports type-variables" $ do+            compact "void foo(`a a);" `shouldBe` "void foo(`a a);\n"+            compact "`a id(const `a a) { return a; }"+                `shouldBe` "`a id(`a const a)\n{\nreturn a;\n}\n"++        it "formats expressions and statements" $ do+            compact "void foo() { return 1+2*3/4; }"+                `shouldBe` "void foo()\n{\nreturn 1 + 2 * 3 / 4;\n}\n"+            compact "void foo() { a = ~b << !c; }"+                `shouldBe` "void foo()\n{\na = ~b << !c;\n}\n"+            compact "void foo() { int a[] = {1,2,3}; }"+                `shouldBe` "void foo()\n{\nint a[] = { 1, 2, 3 };\n}\n"++        it "supports variadic functions" $ do+            compact "void foo(int a, ...);"+                `shouldBe` "void foo(int a, ...);\n"+            compact "void foo(int a, const char *msg, ...);"+                `shouldBe` "void foo(int a, char const* msg, ...);\n"++        it "supports C preprocessor directives" $ do+            compact "#define XYZZY 123\n"+                `shouldBe` "#define XYZZY 123\n"+            compact "#include <tox/tox.h>\n"+                `shouldBe` "#include <tox/tox.h>\n"

@@ -3,9 +3,9 @@  import           Test.Hspec         (Spec, describe, it, shouldBe) -import           Language.Cimple    (AlexPosn (..), Lexeme (..),-                                     LexemeClass (..), LiteralType (..),-                                     Node (..), Scope (..))+import           Language.Cimple    (AlexPosn (..), CommentStyle (..),+                                     Lexeme (..), LexemeClass (..),+                                     LiteralType (..), Node (..), Scope (..)) import           Language.Cimple.IO (parseText)  @@ -13,7 +13,7 @@ spec =     describe "C parsing" $ do         it "should parse a simple function" $ do-            ast <- parseText "int a(void) { return 3; }"+            let ast = parseText "int a(void) { return 3; }"             ast `shouldBe` Right                 [ FunctionDefn                       Global@@ -33,7 +33,7 @@                 ]          it "should parse a type declaration" $ do-            ast <- parseText "typedef struct Foo { int x; } Foo;"+            let ast = parseText "typedef struct Foo { int x; } Foo;"             ast `shouldBe` Right                 [ Typedef                       (Struct@@ -48,7 +48,7 @@                 ]          it "should parse a struct with bit fields" $ do-            ast <- parseText "typedef struct Foo { int x : 123; } Foo;"+            let ast = parseText "typedef struct Foo { int x : 123; } Foo;"             ast `shouldBe` Right                 [ Typedef                       (Struct@@ -63,6 +63,34 @@                 ]          it "should parse a comment" $ do-            ast <- parseText "/* hello */"+            let ast = parseText "/* hello */"             ast `shouldBe` Right-                [Comment [CommentWord (L (AlexPn 3 1 4) CmtWord "hello")]]+                [ Comment Regular+                          (L (AlexPn 0 1 1) CmtStart "/*")+                          [CommentWord (L (AlexPn 3 1 4) CmtWord "hello")]+                          (L (AlexPn 9 1 10) CmtEnd "*/")+                ]++        it "supports single declarators" $ do+            let ast = parseText "int main() { int a; }"+            ast `shouldBe` Right+                [ FunctionDefn+                      Global+                      (FunctionPrototype+                          (TyStd (L (AlexPn 0 1 1) IdStdType "int"))+                          (L (AlexPn 4 1 5) IdVar "main")+                          []+                      )+                      [ VarDecl+                            (TyStd (L (AlexPn 13 1 14) IdStdType "int"))+                            (Declarator+                                (DeclSpecVar (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+                "Parse error near token: L (AlexPn 18 1 19) PctComma \",\"; expected one of [\"';'\"]"

@@ -0,0 +1,20 @@+module Main (main) where++import           Language.Cimple.IO     (parseFile)+import           Language.Cimple.Pretty (ppTranslationUnit)+import           System.Environment     (getArgs)+++processFile :: FilePath -> IO ()+processFile source = do+    putStrLn $ "Processing " ++ source+    ast <- parseFile source+    case ast of+        Left  err -> fail err+        Right ok  -> print $ ppTranslationUnit $ snd ok+++main :: IO ()+main = do+    args <- getArgs+    mapM_ processFile args

@@ -1,23 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import           Language.Cimple.IO (parseFile)-import           System.Environment (getArgs)-import           Text.Groom         (groom)---processFile :: FilePath -> IO ()-processFile source = do-    putStrLn $ "Processing " ++ source-    ast <- parseFile source-    case ast of-        Left err -> fail err-        Right ok -> putStrLn $ groom ok+import           Language.Cimple.IO      (parseProgram)+import qualified Language.Cimple.Program as Program+import           System.Environment      (getArgs)+import           Text.Groom              (groom)   main :: IO () main = do   args <- getArgs   case args of-    [src] -> processFile src-    _     -> fail "Usage: dump-ast <file.c>"+    [] -> fail "Usage: dump-ast [FILE]..."+    srcs ->+      parseProgram srcs+      >>= getRight+      >>= mapM_ (putStrLn . groom) . Program.toList+  where+    getRight (Left err) = fail err+    getRight (Right ok) = return ok

@@ -0,0 +1,20 @@+module Main (main) where++import           Language.Cimple.IO      (parseProgram)+import qualified Language.Cimple.Program as Program+import           System.Environment      (getArgs)+import           Text.Groom              (groom)+++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> fail "Usage: include-graph [FILE]..."+    srcs ->+      parseProgram srcs+      >>= getRight+      >>= mapM_ (putStrLn . groom) . Program.includeGraph+  where+    getRight (Left err) = fail err+    getRight (Right ok) = return ok