cimple 0.0.3 → 0.0.4

raw patch · 11 files changed

+217/−187 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cimple.cabal +1/−1
• src/Language/Cimple/AST.hs +75/−74
• src/Language/Cimple/Diagnostics.hs +2/−2
• src/Language/Cimple/IO.hs +4/−4
• src/Language/Cimple/Parser.y +4/−2
• src/Language/Cimple/Pretty.hs +74/−49
• src/Language/Cimple/Program.hs +2/−2
• src/Language/Cimple/SemCheck/Includes.hs +1/−1
• src/Language/Cimple/TranslationUnit.hs +1/−1
• src/Language/Cimple/TraverseAst.hs +44/−45
• src/Language/Cimple/TreeParser.y +9/−6

@@ -1,5 +1,5 @@ name:                 cimple-version:              0.0.3+version:              0.0.4 synopsis:             Simple C-like programming language homepage:             https://toktok.github.io/ license:              GPL-3

@@ -15,111 +15,112 @@ import           Data.Aeson   (FromJSON, ToJSON) import           GHC.Generics (Generic) -data Node lexeme+data Node a lexeme+    = Attr a     -- Preprocessor-    = PreprocInclude lexeme+    | PreprocInclude lexeme     | PreprocDefine lexeme-    | PreprocDefineConst lexeme (Node lexeme)-    | PreprocDefineMacro lexeme [Node lexeme] (Node lexeme)-    | PreprocIf (Node lexeme) [Node lexeme] (Node lexeme)-    | PreprocIfdef lexeme [Node lexeme] (Node lexeme)-    | PreprocIfndef lexeme [Node lexeme] (Node lexeme)-    | PreprocElse [Node lexeme]-    | PreprocElif (Node lexeme) [Node lexeme] (Node lexeme)+    | PreprocDefineConst lexeme (Node a lexeme)+    | PreprocDefineMacro lexeme [Node a lexeme] (Node a lexeme)+    | PreprocIf (Node a lexeme) [Node a lexeme] (Node a lexeme)+    | PreprocIfdef lexeme [Node a lexeme] (Node a lexeme)+    | PreprocIfndef lexeme [Node a lexeme] (Node a lexeme)+    | PreprocElse [Node a lexeme]+    | PreprocElif (Node a lexeme) [Node a lexeme] (Node a lexeme)     | PreprocUndef lexeme     | PreprocDefined lexeme-    | PreprocScopedDefine (Node lexeme) [Node lexeme] (Node lexeme)-    | MacroBodyStmt [Node lexeme]-    | MacroBodyFunCall (Node lexeme)+    | PreprocScopedDefine (Node a lexeme) [Node a lexeme] (Node a lexeme)+    | MacroBodyStmt [Node a lexeme]+    | MacroBodyFunCall (Node a lexeme)     | MacroParam lexeme-    | StaticAssert (Node lexeme) lexeme+    | StaticAssert (Node a lexeme) lexeme     -- Comments-    | LicenseDecl lexeme [Node lexeme]+    | LicenseDecl lexeme [Node a lexeme]     | CopyrightDecl lexeme (Maybe lexeme) [lexeme]-    | Comment CommentStyle lexeme [Node lexeme] lexeme+    | Comment CommentStyle lexeme [Node a lexeme] lexeme     | CommentBlock lexeme     | CommentWord lexeme-    | Commented (Node lexeme) (Node lexeme)+    | Commented (Node a lexeme) (Node a lexeme)     -- Namespace-like blocks-    | ExternC [Node lexeme]-    | Class Scope lexeme [Node lexeme] [Node lexeme]-    | Namespace Scope lexeme [Node lexeme]+    | ExternC [Node a lexeme]+    | Class Scope lexeme [Node a lexeme] [Node a lexeme]+    | Namespace Scope lexeme [Node a lexeme]     -- Statements-    | CompoundStmt [Node lexeme]+    | CompoundStmt [Node a lexeme]     | Break     | Goto lexeme     | Continue-    | Return (Maybe (Node lexeme))-    | SwitchStmt (Node lexeme) [Node lexeme]-    | IfStmt (Node lexeme) [Node lexeme] (Maybe (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)-    | Default (Node lexeme)-    | Label lexeme (Node lexeme)+    | Return (Maybe (Node a lexeme))+    | SwitchStmt (Node a lexeme) [Node a lexeme]+    | IfStmt (Node a lexeme) [Node a lexeme] (Maybe (Node a lexeme))+    | ForStmt (Node a lexeme) (Node a lexeme) (Node a lexeme) [Node a lexeme]+    | WhileStmt (Node a lexeme) [Node a lexeme]+    | DoWhileStmt [Node a lexeme] (Node a lexeme)+    | Case (Node a lexeme) (Node a lexeme)+    | Default (Node a lexeme)+    | Label lexeme (Node a lexeme)     -- Variable declarations-    | VLA (Node lexeme) lexeme (Node lexeme)-    | VarDecl (Node lexeme) (Node lexeme)-    | Declarator (Node lexeme) (Maybe (Node lexeme))+    | VLA (Node a lexeme) lexeme (Node a lexeme)+    | VarDecl (Node a lexeme) (Node a lexeme)+    | Declarator (Node a lexeme) (Maybe (Node a lexeme))     | DeclSpecVar lexeme-    | DeclSpecArray (Node lexeme) (Maybe (Node lexeme))+    | DeclSpecArray (Node a lexeme) (Maybe (Node a lexeme))     -- Expressions-    | InitialiserList [Node lexeme]-    | UnaryExpr UnaryOp (Node lexeme)-    | BinaryExpr (Node lexeme) BinaryOp (Node lexeme)-    | TernaryExpr (Node lexeme) (Node lexeme) (Node lexeme)-    | AssignExpr (Node lexeme) AssignOp (Node lexeme)-    | ParenExpr (Node lexeme)-    | CastExpr (Node lexeme) (Node lexeme)-    | CompoundExpr (Node lexeme) (Node lexeme)-    | SizeofExpr (Node lexeme)-    | SizeofType (Node lexeme)+    | InitialiserList [Node a lexeme]+    | UnaryExpr UnaryOp (Node a lexeme)+    | BinaryExpr (Node a lexeme) BinaryOp (Node a lexeme)+    | TernaryExpr (Node a lexeme) (Node a lexeme) (Node a lexeme)+    | AssignExpr (Node a lexeme) AssignOp (Node a lexeme)+    | ParenExpr (Node a lexeme)+    | CastExpr (Node a lexeme) (Node a lexeme)+    | CompoundExpr (Node a lexeme) (Node a lexeme)+    | SizeofExpr (Node a lexeme)+    | SizeofType (Node a lexeme)     | LiteralExpr LiteralType lexeme     | VarExpr lexeme-    | MemberAccess (Node lexeme) lexeme-    | PointerAccess (Node lexeme) lexeme-    | ArrayAccess (Node lexeme) (Node lexeme)-    | FunctionCall (Node lexeme) [Node lexeme]-    | CommentExpr (Node lexeme) (Node lexeme)+    | MemberAccess (Node a lexeme) lexeme+    | PointerAccess (Node a lexeme) lexeme+    | ArrayAccess (Node a lexeme) (Node a lexeme)+    | FunctionCall (Node a lexeme) [Node a lexeme]+    | CommentExpr (Node a lexeme) (Node a lexeme)     -- Type definitions-    | EnumClass lexeme [Node lexeme]-    | EnumConsts (Maybe lexeme) [Node lexeme]-    | EnumDecl lexeme [Node lexeme] lexeme-    | Enumerator lexeme (Maybe (Node lexeme))-    | ClassForward lexeme [Node lexeme]-    | Typedef (Node lexeme) lexeme-    | TypedefFunction (Node lexeme)-    | Struct lexeme [Node lexeme]-    | Union lexeme [Node lexeme]-    | MemberDecl (Node lexeme) (Node lexeme) (Maybe lexeme)-    | TyConst (Node lexeme)-    | TyPointer (Node lexeme)+    | EnumClass lexeme [Node a lexeme]+    | EnumConsts (Maybe lexeme) [Node a lexeme]+    | EnumDecl lexeme [Node a lexeme] lexeme+    | Enumerator lexeme (Maybe (Node a lexeme))+    | ClassForward lexeme [Node a lexeme]+    | Typedef (Node a lexeme) lexeme+    | TypedefFunction (Node a lexeme)+    | Struct lexeme [Node a lexeme]+    | Union lexeme [Node a lexeme]+    | MemberDecl (Node a lexeme) (Node a lexeme) (Maybe lexeme)+    | TyConst (Node a lexeme)+    | TyPointer (Node a lexeme)     | TyStruct lexeme     | TyFunc lexeme     | TyStd lexeme     | TyVar lexeme     | TyUserDefined lexeme     -- Functions-    | FunctionDecl Scope (Node lexeme) (Maybe (Node lexeme))-    | FunctionDefn Scope (Node lexeme) [Node lexeme]-    | FunctionPrototype (Node lexeme) lexeme [Node lexeme]-    | FunctionParam (Node lexeme) (Node lexeme)-    | Event lexeme (Node lexeme)-    | EventParams [Node lexeme]-    | Property (Node lexeme) (Node lexeme) [Node lexeme]-    | Accessor lexeme [Node lexeme] (Maybe (Node lexeme))-    | ErrorDecl lexeme [Node lexeme]-    | ErrorList [Node lexeme]+    | FunctionDecl Scope (Node a lexeme) (Maybe (Node a lexeme))+    | FunctionDefn Scope (Node a lexeme) [Node a lexeme]+    | FunctionPrototype (Node a lexeme) lexeme [Node a lexeme]+    | FunctionParam (Node a lexeme) (Node a lexeme)+    | Event lexeme (Node a lexeme)+    | EventParams [Node a lexeme]+    | Property (Node a lexeme) (Node a lexeme) [Node a lexeme]+    | Accessor lexeme [Node a lexeme] (Maybe (Node a lexeme))+    | ErrorDecl lexeme [Node a lexeme]+    | ErrorList [Node a lexeme]     | ErrorFor lexeme     | Ellipsis     -- Constants-    | ConstDecl (Node lexeme) lexeme-    | ConstDefn Scope (Node lexeme) lexeme (Node lexeme)+    | ConstDecl (Node a lexeme) lexeme+    | ConstDefn Scope (Node a lexeme) lexeme (Node a lexeme)     deriving (Show, Eq, Generic, Functor, Foldable, Traversable) -instance FromJSON lexeme => FromJSON (Node lexeme)-instance ToJSON lexeme => ToJSON (Node lexeme)+instance (FromJSON a, FromJSON lexeme) => FromJSON (Node a lexeme)+instance (ToJSON a, ToJSON lexeme) => ToJSON (Node a lexeme)  data AssignOp     = AopEq

@@ -33,11 +33,11 @@ warn file l w = State.modify (addDiagnostic $ sloc file l <> ": " <> w)  -sloc :: FilePath -> Lexeme a -> Text+sloc :: FilePath -> Lexeme text -> Text sloc file l = Text.pack file <> ":" <> Text.pack (show (lexemeLine l))  -at :: Node (Lexeme Text) -> Lexeme Text+at :: Node a (Lexeme Text) -> Lexeme Text at n =     case foldMap (:[]) n of         []  -> L (AlexPn 0 0 0) Error "unknown source location"

@@ -36,20 +36,20 @@             return text  -process :: [Node (Lexeme String)] -> [Node (Lexeme Text)]+process :: [Node a (Lexeme String)] -> [Node a (Lexeme Text)] process stringAst =     evalState (mapM (mapM (mapM cacheText)) stringAst) Map.empty  -parseText :: Text -> Either String [Node (Lexeme Text)]+parseText :: Text -> Either String [Node () (Lexeme Text)] parseText contents =     process <$> res   where-    res :: Either String [Node (Lexeme String)]+    res :: Either String [Node () (Lexeme String)]     res =         runAlex (Text.unpack contents) Parser.parseTranslationUnit -parseTextStrict :: Text -> Either String [Node (Lexeme Text)]+parseTextStrict :: Text -> Either String [Node () (Lexeme Text)] parseTextStrict = parseText >=> TreeParser.toEither . TreeParser.parseTranslationUnit  

@@ -1,5 +1,7 @@ {-module Language.Cimple.Parser where+module Language.Cimple.Parser+    ( parseTranslationUnit+    ) where  import           Language.Cimple.AST    (AssignOp (..), BinaryOp (..),                                          CommentStyle (..), LiteralType (..),@@ -720,7 +722,7 @@  { type StringLexeme = Lexeme String-type StringNode = Node StringLexeme+type StringNode = Node () StringLexeme  parseError :: Show text => (Lexeme text, [String]) -> Alex a parseError (L (AlexPn _ line col) c t, options) =

@@ -24,7 +24,7 @@ ppLineSep :: (a -> Doc) -> [a] -> Doc ppLineSep go = foldr (<>) empty . List.intersperse linebreak . map go -ppComment :: CommentStyle -> [Node (Lexeme Text)] -> Doc+ppComment :: Show a => CommentStyle -> [Node a (Lexeme Text)] -> Doc ppComment style cs =     nest 1 (ppCommentStyle style <> ppCommentBody cs) <+> text "*/" @@ -33,12 +33,9 @@ ppCommentStyle Doxygen = text "/**" ppCommentStyle Regular = text "/*" -ppCommentBody :: [Node (Lexeme Text)] -> Doc-ppCommentBody = go . map unCommentWord+ppCommentWords :: [Lexeme Text] -> Doc+ppCommentWords = go   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) =@@ -74,11 +71,17 @@     ppWord (L _ PctComma         t) = space <> ppText t     ppWord x                        = error $ groom x +ppCommentBody :: Show a => [Node a (Lexeme Text)] -> Doc+ppCommentBody = ppCommentWords . map unCommentWord+  where+    unCommentWord (CommentWord l) = l+    unCommentWord x               = error $ groom x+ ppScope :: Scope -> Doc ppScope Global = empty ppScope Static = text "static " -ppType :: Node (Lexeme Text) -> Doc+ppType :: Show a => Node a (Lexeme Text) -> Doc ppType (TyPointer     ty) = ppType ty <> char '*' ppType (TyConst       ty) = ppType ty <+> text "const" ppType (TyUserDefined l ) = ppLexeme l@@ -133,10 +136,10 @@     UopIncr    -> text "++"     UopDecr    -> text "--" -ppInitialiserList :: [Node (Lexeme Text)] -> Doc+ppInitialiserList :: Show a => [Node a (Lexeme Text)] -> Doc ppInitialiserList l = char '{' <+> ppCommaSep ppExpr l <+> char '}' -ppDeclSpec :: Node (Lexeme Text) -> Doc+ppDeclSpec :: Show a => Node a (Lexeme Text) -> Doc ppDeclSpec (DeclSpecVar var        ) = ppLexeme var ppDeclSpec (DeclSpecArray dspec dim) = ppDeclSpec dspec <> ppDim dim   where@@ -144,14 +147,14 @@     ppDim (Just x) = char '[' <> ppExpr x <> char ']' ppDeclSpec x = error $ groom x -ppDeclarator :: Node (Lexeme Text) -> Doc+ppDeclarator :: Show a => Node a (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 :: Show a => [Node a (Lexeme Text)] -> Doc ppFunctionParamList xs = char '(' <> ppCommaSep go xs <> char ')'   where     go (TyStd l@(L _ KwVoid _)) = ppLexeme l@@ -160,14 +163,15 @@     go x                        = error $ groom x  ppFunctionPrototype-    :: Node (Lexeme Text)+    :: Show a+    => Node a (Lexeme Text)     -> Lexeme Text-    -> [Node (Lexeme Text)]+    -> [Node a (Lexeme Text)]     -> Doc ppFunctionPrototype ty name params =     ppType ty <+> ppLexeme name <> ppFunctionParamList params -ppWithError :: Maybe (Node (Lexeme Text)) -> Doc+ppWithError :: Show a => Maybe (Node a (Lexeme Text)) -> Doc ppWithError Nothing = char ';' ppWithError (Just (ErrorFor name)) =     text " with error for" <+> ppLexeme name <> char ';'@@ -178,11 +182,11 @@     ) <$> char '}' ppWithError x = error $ groom x -ppFunctionCall :: Node (Lexeme Text) -> [Node (Lexeme Text)] -> Doc+ppFunctionCall :: Show a => Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc ppFunctionCall callee args =     ppExpr callee <> char '(' <> ppCommaSep ppExpr args <> char ')' -ppMacroBody :: Node (Lexeme Text) -> Doc+ppMacroBody :: Show a => Node a (Lexeme Text) -> Doc ppMacroBody (MacroBodyFunCall e@FunctionCall{}) = ppExpr e ppMacroBody (MacroBodyStmt body) =     nest 2 (@@ -191,12 +195,12 @@     ) <$> text "} while (0)" ppMacroBody x                                   = error $ groom x -ppMacroParam :: Node (Lexeme Text) -> Doc+ppMacroParam :: Show a => Node a (Lexeme Text) -> Doc ppMacroParam (MacroParam l) = ppLexeme l ppMacroParam Ellipsis       = text "..." ppMacroParam x              = error $ groom x -ppMacroParamList :: [Node (Lexeme Text)] -> Doc+ppMacroParamList :: Show a => [Node a (Lexeme Text)] -> Doc ppMacroParamList xs = char '(' <> ppCommaSep ppMacroParam xs <> char ')'  ppNamespace :: ([a] -> Doc) -> Scope -> Lexeme Text -> [a] -> Doc@@ -207,7 +211,7 @@         pp members     ) <$> char '}' -ppEnumerator :: Node (Lexeme Text) -> Doc+ppEnumerator :: Show a => Node a (Lexeme Text) -> Doc ppEnumerator (Comment    style _ cs _ ) = ppComment style cs ppEnumerator (Enumerator name  Nothing) = ppLexeme name <> char ',' ppEnumerator (Enumerator name (Just value)) =@@ -216,52 +220,53 @@     ppNamespace ppEnumeratorList scope name members ppEnumerator x = error $ groom x -ppEnumeratorList :: [Node (Lexeme Text)] -> Doc+ppEnumeratorList :: Show a => [Node a (Lexeme Text)] -> Doc ppEnumeratorList = ppLineSep ppEnumerator -ppMemberDecl :: Node (Lexeme Text) -> Doc+ppMemberDecl :: Show a => Node a (Lexeme Text) -> Doc ppMemberDecl = ppDecl -ppMemberDeclList :: [Node (Lexeme Text)] -> Doc+ppMemberDeclList :: Show a => [Node a (Lexeme Text)] -> Doc ppMemberDeclList = ppLineSep ppMemberDecl -ppAccessor :: Node (Lexeme Text) -> Doc+ppAccessor :: Show a => Node a (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 :: Show a => [Node a (Lexeme Text)] -> Doc ppAccessorList = ppLineSep ppAccessor -ppEventType :: Node (Lexeme Text) -> Doc+ppEventType :: Show a => Node a (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 :: Show a => [Node a (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 :: Show a => [Node a (Lexeme Text)] -> Doc ppCompoundStmt body =     nest 2 (         char '{' <$>         ppStmtList body     ) <$> char '}' -ppStmtList :: [Node (Lexeme Text)] -> Doc+ppStmtList :: Show a => [Node a (Lexeme Text)] -> Doc ppStmtList = ppLineSep ppDecl  ppIfStmt-    :: Node (Lexeme Text)-    -> [Node (Lexeme Text)]-    -> Maybe (Node (Lexeme Text))+    :: Show a+    => Node a (Lexeme Text)+    -> [Node a (Lexeme Text)]+    -> Maybe (Node a (Lexeme Text))     -> Doc ppIfStmt cond t Nothing =     nest 2 (@@ -275,10 +280,11 @@     ) <$> nest 2 (char '}' <> text " else " <> ppDecl e)  ppForStmt-    :: Node (Lexeme Text)-    -> Node (Lexeme Text)-    -> Node (Lexeme Text)-    -> [Node (Lexeme Text)]+    :: Show a+    => Node a (Lexeme Text)+    -> Node a (Lexeme Text)+    -> Node a (Lexeme Text)+    -> [Node a (Lexeme Text)]     -> Doc ppForStmt i c n body =     nest 2 (@@ -291,8 +297,9 @@     ) <$> char '}'  ppWhileStmt-    :: Node (Lexeme Text)-    -> [Node (Lexeme Text)]+    :: Show a+    => Node a (Lexeme Text)+    -> [Node a (Lexeme Text)]     -> Doc ppWhileStmt c body =     nest 2 (@@ -303,8 +310,9 @@     ) <$> char '}'  ppDoWhileStmt-    :: [Node (Lexeme Text)]-    -> Node (Lexeme Text)+    :: Show a+    => [Node a (Lexeme Text)]+    -> Node a (Lexeme Text)     -> Doc ppDoWhileStmt body c =     nest 2 (@@ -314,8 +322,9 @@     ) <$> text "} while (" <> ppExpr c <> char ')'  ppSwitchStmt-    :: Node (Lexeme Text)-    -> [Node (Lexeme Text)]+    :: Show a+    => Node a (Lexeme Text)+    -> [Node a (Lexeme Text)]     -> Doc ppSwitchStmt c body =     nest 2 (@@ -325,7 +334,7 @@         ppStmtList body     ) <$> char '}' -ppExpr :: Node (Lexeme Text) -> Doc+ppExpr :: Show a => Node a (Lexeme Text) -> Doc ppExpr expr = case expr of     -- Expressions     VarExpr var       -> ppLexeme var@@ -346,26 +355,42 @@     PointerAccess e m -> ppExpr e <> text "->" <> ppLexeme m     MemberAccess  e m -> ppExpr e <> text "." <> ppLexeme m     CommentExpr   c e -> ppCommentExpr c e+    LicenseDecl l cs  -> ppLicenseDecl l cs      x                 -> error $ groom x  ppTernaryExpr-    :: Node (Lexeme Text) -> Node (Lexeme Text) -> Node (Lexeme Text) -> Doc+    :: Show a => Node a (Lexeme Text) -> Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc ppTernaryExpr c t e =     ppExpr c <+> char '?' <+> ppExpr t <+> char ':' <+> ppExpr e -ppCommentExpr :: Node (Lexeme Text) -> Node (Lexeme Text) -> Doc+ppLicenseDecl :: Show a => Lexeme Text -> [Node a (Lexeme Text)] -> Doc+ppLicenseDecl l cs =+    ppCommentStyle Regular <+> ppLexeme l <$>+    ppLineSep ppCopyrightDecl cs++ppCopyrightDecl :: Show a => Node a (Lexeme Text) -> Doc+ppCopyrightDecl (CopyrightDecl from (Just to) owner) =+    ppLexeme from <> char '-' <> ppLexeme to <+>+    ppCommentWords owner+ppCopyrightDecl (CopyrightDecl from Nothing owner) =+    ppLexeme from <+>+    ppCommentWords owner+ppCopyrightDecl x =+    error $ groom x++ppCommentExpr :: Show a => Node a (Lexeme Text) -> Node a (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 :: Show a => Node a (Lexeme Text) -> Doc ppStmt = ppDecl -ppDeclList :: [Node (Lexeme Text)] -> Doc+ppDeclList :: Show a => [Node a (Lexeme Text)] -> Doc ppDeclList = ppLineSep ppDecl -ppDecl :: Node (Lexeme Text) -> Doc+ppDecl :: Show a => Node a (Lexeme Text) -> Doc ppDecl decl = case decl of     PreprocElif cond decls (PreprocElse []) ->         text "#elif" <+> ppExpr cond <$>@@ -554,7 +579,7 @@     x                     -> ppExpr x <> char ';'  -ppVLA :: Node (Lexeme Text) -> Lexeme Text -> Node (Lexeme Text) -> Doc+ppVLA :: Show a => Node a (Lexeme Text) -> Lexeme Text -> Node a (Lexeme Text) -> Doc ppVLA ty n sz =     text "VLA("         <> ppType ty@@ -564,5 +589,5 @@         <> ppExpr sz         <> text ");" -ppTranslationUnit :: [Node (Lexeme Text)] -> Doc+ppTranslationUnit :: Show a => [Node a (Lexeme Text)] -> Doc ppTranslationUnit decls = ppDeclList decls <> linebreak

@@ -19,8 +19,8 @@ import           Language.Cimple.TranslationUnit   (TranslationUnit)  -data Program a = Program-  { progAsts     :: Map FilePath [Node (Lexeme a)]+data Program text = Program+  { progAsts     :: Map FilePath [Node () (Lexeme text)]   , progIncludes :: Graph () FilePath   } 

@@ -42,7 +42,7 @@   where     (ast', includes) = State.runState (traverseAst (go (takeDirectory file)) ast) [] -    go :: FilePath -> AstActions (State [FilePath]) Text+    go :: FilePath -> AstActions (State [FilePath]) () Text     go dir = defaultActions         { doNode = \_ node act ->             case node of

@@ -6,4 +6,4 @@ import           Language.Cimple.AST   (Node) import           Language.Cimple.Lexer (Lexeme) -type TranslationUnit a = (FilePath, [Node (Lexeme a)])+type TranslationUnit text = (FilePath, [Node () (Lexeme text)])

@@ -1,42 +1,43 @@-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE InstanceSigs        #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE NamedFieldPuns      #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StrictData          #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE StrictData            #-} module Language.Cimple.TraverseAst     ( TraverseAst (..)     , AstActions (..)     , defaultActions     ) where -import           Data.Text             (Text) import           Language.Cimple.AST   (Node (..)) import           Language.Cimple.Lexer (Lexeme (..)) -class TraverseAst a where-    traverseAst :: Applicative f => AstActions f Text -> a -> f a+class TraverseAst attr text a where+    traverseAst :: Applicative f => AstActions f attr text -> a -> f a -data AstActions f text = AstActions+data AstActions f attr text = AstActions     { currentFile :: FilePath-    , doUnits     :: [(FilePath, [Node (Lexeme text)])] -> f [(FilePath, [Node (Lexeme text)])] -> f [(FilePath, [Node (Lexeme text)])]-    , doUnit      ::  (FilePath, [Node (Lexeme text)])  -> f  (FilePath, [Node (Lexeme text)])  -> f  (FilePath, [Node (Lexeme text)])-    , doNodes     :: FilePath -> [Node (Lexeme text)]   -> f             [Node (Lexeme text)]   -> f             [Node (Lexeme text)]-    , doNode      :: FilePath ->  Node (Lexeme text)    -> f             (Node (Lexeme text))   -> f             (Node (Lexeme text))-    , doLexemes   :: FilePath ->       [Lexeme text]    -> f                   [Lexeme text]    -> f                   [Lexeme text]-    , doLexeme    :: FilePath ->        Lexeme text     -> f                   (Lexeme text)    -> f                   (Lexeme text)-    , doText      :: FilePath ->               text     -> f                           text     -> f                           text+    , doFiles     :: [(FilePath, [Node attr (Lexeme text)])] -> f [(FilePath, [Node attr (Lexeme text)])] -> f [(FilePath, [Node attr (Lexeme text)])]+    , doFile      ::  (FilePath, [Node attr (Lexeme text)])  -> f  (FilePath, [Node attr (Lexeme text)])  -> f  (FilePath, [Node attr (Lexeme text)])+    , doNodes     :: FilePath -> [Node attr (Lexeme text)]   -> f             [Node attr (Lexeme text)]   -> f             [Node attr (Lexeme text)]+    , doNode      :: FilePath ->  Node attr (Lexeme text)    -> f             (Node attr (Lexeme text))   -> f             (Node attr (Lexeme text))+    , doLexemes   :: FilePath ->            [Lexeme text]    -> f                        [Lexeme text]    -> f                        [Lexeme text]+    , doLexeme    :: FilePath ->             Lexeme text     -> f                        (Lexeme text)    -> f                        (Lexeme text)+    , doText      :: FilePath ->                    text     -> f                                text     -> f                                text     } -instance TraverseAst a => TraverseAst (Maybe a) where+instance TraverseAst attr text a => TraverseAst attr text (Maybe a) where     traverseAst _          Nothing  = pure Nothing     traverseAst astActions (Just x) = Just <$> traverseAst astActions x -defaultActions :: Applicative f => AstActions f lexeme+defaultActions :: Applicative f => AstActions f attr text defaultActions = AstActions     { currentFile = "<stdin>"-    , doUnits     = const id-    , doUnit      = const id+    , doFiles     = const id+    , doFile      = const id     , doNodes     = const $ const id     , doNode      = const $ const id     , doLexeme    = const $ const id@@ -44,28 +45,28 @@     , doText      = const $ const id     } -instance TraverseAst Text where-    traverseAst :: forall f . Applicative f-                => AstActions f Text -> Text -> f Text-    traverseAst astActions@AstActions{currentFile} = doText astActions currentFile <*> pure+instance TraverseAst attr text text where+    traverseAst AstActions{..} = doText currentFile <*> pure -instance TraverseAst (Lexeme Text) where+instance TraverseAst attr text (Lexeme text) where     traverseAst :: forall f . Applicative f-                => AstActions f Text -> Lexeme Text -> f (Lexeme Text)-    traverseAst astActions@AstActions{currentFile} = doLexeme astActions currentFile <*> \case-        L p c s -> L p c <$> recurse s+                => AstActions f attr text -> Lexeme text -> f (Lexeme text)+    traverseAst astActions@AstActions{..} = doLexeme currentFile <*>+        \(L p c s) -> L p c <$> recurse s       where-        recurse :: TraverseAst a => a -> f a+        recurse :: TraverseAst attr text a => a -> f a         recurse = traverseAst astActions -instance TraverseAst [Lexeme Text] where-    traverseAst astActions@AstActions{currentFile} = doLexemes astActions currentFile <*>+instance TraverseAst attr text [Lexeme text] where+    traverseAst astActions@AstActions{..} = doLexemes currentFile <*>         traverse (traverseAst astActions) -instance TraverseAst (Node (Lexeme Text)) where+instance TraverseAst attr text (Node attr (Lexeme text)) where     traverseAst :: forall f . Applicative f-                => AstActions f Text -> Node (Lexeme Text) -> f (Node (Lexeme Text))-    traverseAst astActions@AstActions{currentFile} = doNode astActions currentFile <*> \case+                => AstActions f attr text -> Node attr (Lexeme text) -> f (Node attr (Lexeme text))+    traverseAst astActions@AstActions{..} = doNode currentFile <*> \case+        attr@Attr{} ->+            pure attr         PreprocInclude path ->             PreprocInclude <$> recurse path         PreprocDefine name ->@@ -250,19 +251,17 @@             ConstDefn scope <$> recurse ty <*> recurse name <*> recurse value        where-        recurse :: TraverseAst a => a -> f a+        recurse :: TraverseAst attr text a => a -> f a         recurse = traverseAst astActions -instance TraverseAst [Node (Lexeme Text)] where-    traverseAst astActions@AstActions{currentFile} = doNodes astActions currentFile <*>+instance TraverseAst attr text [Node attr (Lexeme text)] where+    traverseAst astActions@AstActions{..} = doNodes currentFile <*>         traverse (traverseAst astActions) -instance TraverseAst (FilePath, [Node (Lexeme Text)]) where-    traverseAst astActions tu@(currentFile, _) = doUnit astActions' <*>-        traverse (traverseAst astActions') $ tu-      where-        astActions' = astActions{currentFile}+instance TraverseAst attr text (FilePath, [Node attr (Lexeme text)]) where+    traverseAst astActions@AstActions{doFile} tu@(currentFile, _) = doFile <*>+        traverse (traverseAst astActions{currentFile}) $ tu -instance TraverseAst [(FilePath, [Node (Lexeme Text)])] where-    traverseAst astActions = doUnits astActions <*>+instance TraverseAst attr text [(FilePath, [Node attr (Lexeme text)])] where+    traverseAst astActions@AstActions{..} = doFiles <*>         traverse (traverseAst astActions)

@@ -1,6 +1,10 @@ { {-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Language.Cimple.TreeParser where+module Language.Cimple.TreeParser+    ( TreeParser+    , parseTranslationUnit+    , toEither+    ) where  import           Data.Text             (Text) import           Language.Cimple.AST   (CommentStyle (..), Node (..))@@ -210,7 +214,7 @@  { type TextLexeme = Lexeme Text-type TextNode = Node TextLexeme+type TextNode = Node () TextLexeme  newtype TreeParser a = TreeParser { toEither :: Either String a }     deriving (Functor, Applicative, Monad)@@ -258,8 +262,7 @@   parseError :: ([TextNode], [String]) -> TreeParser a-parseError ([], options) =-    fail $ "end of file; expected one of " <> show options-parseError (n:_, options) =-    fail $ show n <> "; expected one of " <> show options+parseError ([], options)  = fail $ "end of file; expected one of " <> show options+parseError (n:_, [])      = fail $ show n <> "; expected end of file"+parseError (n:_, options) = fail $ show n <> "; expected one of " <> show options }