cimple 0.0.11 → 0.0.12
raw patch · 6 files changed
+631/−242 lines, 6 filesdep +monad-parallelPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: monad-parallel
API changes (from Hackage documentation)
- Language.Cimple: traverseAst :: (TraverseAst itext otext a, Applicative f) => AstActions f itext otext -> a -> f (Mapped itext otext a)
+ Language.Cimple: mapAst :: (MapAst itext otext a, Applicative f) => AstActions f itext otext -> a -> f (Mapped itext otext a)
Files
- cimple.cabal +3/−1
- src/Language/Cimple.hs +10/−10
- src/Language/Cimple/IO.hs +5/−4
- src/Language/Cimple/MapAst.hs +278/−0
- src/Language/Cimple/SemCheck/Includes.hs +3/−3
- src/Language/Cimple/TraverseAst.hs +332/−224
cimple.cabal view
@@ -1,5 +1,5 @@ name: cimple-version: 0.0.11+version: 0.0.12 synopsis: Simple C-like programming language homepage: https://toktok.github.io/ license: GPL-3@@ -37,6 +37,7 @@ , Language.Cimple.Flatten , Language.Cimple.Graph , Language.Cimple.Lexer+ , Language.Cimple.MapAst , Language.Cimple.Parser , Language.Cimple.SemCheck.Includes , Language.Cimple.Tokens@@ -53,6 +54,7 @@ , data-fix , filepath , groom+ , monad-parallel , mtl , recursion-schemes , text
src/Language/Cimple.hs view
@@ -5,16 +5,16 @@ , removeSloc ) where -import Control.Monad.State.Strict (State)-import qualified Control.Monad.State.Strict as State-import Data.Text (Text)+import Control.Monad.State.Strict (State)+import qualified Control.Monad.State.Strict as State+import Data.Text (Text) -import Language.Cimple.Annot as X-import Language.Cimple.Ast as X-import Language.Cimple.Lexer as X-import Language.Cimple.Parser as X-import Language.Cimple.Tokens as X-import Language.Cimple.TraverseAst as X+import Language.Cimple.Annot as X+import Language.Cimple.Ast as X+import Language.Cimple.Lexer as X+import Language.Cimple.MapAst as X+import Language.Cimple.Parser as X+import Language.Cimple.Tokens as X type DefaultActions a = X.IdentityActions (State a) Text @@ -23,5 +23,5 @@ removeSloc :: Node (Lexeme Text) -> Node (Lexeme Text) removeSloc =- flip State.evalState () . traverseAst defaultActions+ flip State.evalState () . mapAst defaultActions { doLexeme = \_ (L _ c t) _ -> pure $ L (AlexPn 0 0 0) c t }
src/Language/Cimple/IO.hs view
@@ -8,6 +8,7 @@ ) where import Control.Monad ((>=>))+import qualified Control.Monad.Parallel as P import Control.Monad.State.Strict (State, evalState, get, put) import qualified Data.ByteString as BS import Data.Map.Strict (Map)@@ -17,12 +18,12 @@ import qualified Data.Text.Encoding as Text import Language.Cimple.Ast (Node) import Language.Cimple.Lexer (Lexeme, runAlex)+import Language.Cimple.MapAst (TextActions, mapAst,+ textActions) import qualified Language.Cimple.Parser as Parser import Language.Cimple.Program (Program) import qualified Language.Cimple.Program as Program import Language.Cimple.TranslationUnit (TranslationUnit)-import Language.Cimple.TraverseAst (TextActions, textActions,- traverseAst) import qualified Language.Cimple.TreeParser as TreeParser type StringNode = Node (Lexeme String)@@ -30,7 +31,7 @@ toTextAst :: [StringNode] -> [TextNode] toTextAst stringAst =- evalState (traverseAst cacheActions stringAst) Map.empty+ evalState (mapAst cacheActions stringAst) Map.empty where cacheActions :: TextActions (State (Map String Text)) String Text cacheActions = textActions $ \s -> do@@ -65,7 +66,7 @@ parseFiles' :: [FilePath] -> IO (Either String [TranslationUnit Text])-parseFiles' sources = sequenceA <$> traverse parseFile sources+parseFiles' sources = sequenceA <$> P.mapM parseFile sources parseFiles :: [FilePath] -> IO (Either String [TranslationUnit Text])
+ src/Language/Cimple/MapAst.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}+module Language.Cimple.MapAst+ ( mapAst++ , doFiles, doFile+ , doNodes, doNode+ , doLexemes, doLexeme+ , doText++ , astActions+ , TextActions, textActions+ , IdentityActions, identityActions+ ) where++import Data.Fix (Fix (..))+import Language.Cimple.Ast (Node, NodeF (..))+import Language.Cimple.Lexer (Lexeme (..))++class MapAst itext otext a where+ type Mapped itext otext a+ mapFileAst+ :: Applicative f+ => AstActions f itext otext+ -> FilePath+ -> a+ -> f (Mapped itext otext a)++mapAst+ :: (MapAst itext otext a, Applicative f)+ => AstActions f itext otext -> a+ -> f (Mapped itext otext a)+mapAst = flip mapFileAst "<stdin>"++data AstActions f itext otext = AstActions+ { doFiles :: [(FilePath, [Node (Lexeme itext)])] -> f [(FilePath, [Node (Lexeme otext)])] -> f [(FilePath, [Node (Lexeme otext)])]+ , doFile :: (FilePath, [Node (Lexeme itext)]) -> f (FilePath, [Node (Lexeme otext)]) -> f (FilePath, [Node (Lexeme otext)])+ , doNodes :: FilePath -> [Node (Lexeme itext)] -> f [Node (Lexeme otext)] -> f [Node (Lexeme otext)]+ , doNode :: FilePath -> Node (Lexeme itext) -> f (Node (Lexeme otext)) -> f (Node (Lexeme otext))+ , doLexemes :: FilePath -> [Lexeme itext] -> f [Lexeme otext] -> f [Lexeme otext]+ , doLexeme :: FilePath -> Lexeme itext -> f (Lexeme otext) -> f (Lexeme otext)+ , doText :: FilePath -> itext -> f otext+ }++instance MapAst itext otext a+ => MapAst itext otext (Maybe a) where+ type Mapped itext otext (Maybe a)+ = Maybe (Mapped itext otext a)+ mapFileAst _ _ Nothing = pure Nothing+ mapFileAst actions currentFile (Just x) = Just <$> mapFileAst actions currentFile x++astActions+ :: Applicative f+ => (itext -> f otext)+ -> AstActions f itext otext+astActions ft = AstActions+ { doFiles = const id+ , doFile = const id+ , doNodes = const $ const id+ , doNode = const $ const id+ , doLexeme = const $ const id+ , doLexemes = const $ const id+ , doText = const ft+ }++type TextActions f itext otext = AstActions f itext otext+textActions :: Applicative f => (itext -> f otext) -> TextActions f itext otext+textActions = astActions++type IdentityActions f text = AstActions f text text+identityActions :: Applicative f => AstActions f text text+identityActions = astActions pure+++instance MapAst itext otext (Lexeme itext) where+ type Mapped itext otext (Lexeme itext)+ = Lexeme otext+ mapFileAst :: forall f . Applicative f+ => AstActions f itext otext -> FilePath -> Lexeme itext -> f (Lexeme otext)+ mapFileAst AstActions{..} currentFile = doLexeme currentFile <*>+ \(L p c s) -> L p c <$> doText currentFile s++instance MapAst itext otext [Lexeme itext] where+ type Mapped itext otext [Lexeme itext]+ = [Lexeme otext]+ mapFileAst actions@AstActions{..} currentFile = doLexemes currentFile <*>+ traverse (mapFileAst actions currentFile)++instance MapAst itext otext (Node (Lexeme itext)) where+ type Mapped itext otext (Node (Lexeme itext))+ = Node (Lexeme otext)+ mapFileAst+ :: forall f . Applicative f+ => AstActions f itext otext+ -> FilePath+ -> Node (Lexeme itext)+ -> f (Node (Lexeme otext))+ mapFileAst actions@AstActions{..} currentFile = doNode currentFile <*> \node -> case unFix node of+ PreprocInclude path ->+ Fix <$> (PreprocInclude <$> recurse path)+ PreprocDefine name ->+ Fix <$> (PreprocDefine <$> recurse name)+ PreprocDefineConst name value ->+ Fix <$> (PreprocDefineConst <$> recurse name <*> recurse value)+ PreprocDefineMacro name params body ->+ Fix <$> (PreprocDefineMacro <$> recurse name <*> recurse params <*> recurse body)+ PreprocIf cond thenDecls elseBranch ->+ Fix <$> (PreprocIf <$> recurse cond <*> recurse thenDecls <*> recurse elseBranch)+ PreprocIfdef name thenDecls elseBranch ->+ Fix <$> (PreprocIfdef <$> recurse name <*> recurse thenDecls <*> recurse elseBranch)+ PreprocIfndef name thenDecls elseBranch ->+ Fix <$> (PreprocIfndef <$> recurse name <*> recurse thenDecls <*> recurse elseBranch)+ PreprocElse decls ->+ Fix <$> (PreprocElse <$> recurse decls)+ PreprocElif cond decls elseBranch ->+ Fix <$> (PreprocElif <$> recurse cond <*> recurse decls <*> recurse elseBranch)+ PreprocUndef name ->+ Fix <$> (PreprocUndef <$> recurse name)+ PreprocDefined name ->+ Fix <$> (PreprocDefined <$> recurse name)+ PreprocScopedDefine define stmts undef ->+ Fix <$> (PreprocScopedDefine <$> recurse define <*> recurse stmts <*> recurse undef)+ MacroBodyStmt stmts ->+ Fix <$> (MacroBodyStmt <$> recurse stmts)+ MacroBodyFunCall expr ->+ Fix <$> (MacroBodyFunCall <$> recurse expr)+ MacroParam name ->+ Fix <$> (MacroParam <$> recurse name)+ StaticAssert cond msg ->+ Fix <$> (StaticAssert <$> recurse cond <*> recurse msg)+ LicenseDecl license copyrights ->+ Fix <$> (LicenseDecl <$> recurse license <*> recurse copyrights)+ CopyrightDecl from to owner ->+ Fix <$> (CopyrightDecl <$> recurse from <*> recurse to <*> recurse owner)+ Comment doc start contents end ->+ Fix <$> (Comment doc <$> recurse start <*> recurse contents <*> recurse end)+ CommentBlock comment ->+ Fix <$> (CommentBlock <$> recurse comment)+ Commented comment subject ->+ Fix <$> (Commented <$> recurse comment <*> recurse subject)+ ExternC decls ->+ Fix <$> (ExternC <$> recurse decls)+ CompoundStmt stmts ->+ Fix <$> (CompoundStmt <$> recurse stmts)+ Break ->+ pure $ Fix Break+ Goto label ->+ Fix <$> (Goto <$> recurse label)+ Continue ->+ pure $ Fix Continue+ Return value ->+ Fix <$> (Return <$> recurse value)+ SwitchStmt value cases ->+ Fix <$> (SwitchStmt <$> recurse value <*> recurse cases)+ IfStmt cond thenStmts elseStmt ->+ Fix <$> (IfStmt <$> recurse cond <*> recurse thenStmts <*> recurse elseStmt)+ ForStmt initStmt cond next stmts ->+ Fix <$> (ForStmt <$> recurse initStmt <*> recurse cond <*> recurse next <*> recurse stmts)+ WhileStmt cond stmts ->+ Fix <$> (WhileStmt <$> recurse cond <*> recurse stmts)+ DoWhileStmt stmts cond ->+ Fix <$> (DoWhileStmt <$> recurse stmts <*> recurse cond)+ Case value stmt ->+ Fix <$> (Case <$> recurse value <*> recurse stmt)+ Default stmt ->+ Fix <$> (Default <$> recurse stmt)+ Label label stmt ->+ Fix <$> (Label <$> recurse label <*> recurse stmt)+ VLA ty name size ->+ Fix <$> (VLA <$> recurse ty <*> recurse name <*> recurse size)+ VarDeclStmt decl ini ->+ Fix <$> (VarDeclStmt <$> recurse decl <*> recurse ini)+ VarDecl ty name arrs ->+ Fix <$> (VarDecl <$> recurse ty <*> recurse name <*> recurse arrs)+ DeclSpecArray size ->+ Fix <$> (DeclSpecArray <$> recurse size)+ InitialiserList values ->+ Fix <$> (InitialiserList <$> recurse values)+ UnaryExpr op expr ->+ Fix <$> (UnaryExpr op <$> recurse expr)+ BinaryExpr lhs op rhs ->+ Fix <$> (BinaryExpr <$> recurse lhs <*> pure op <*> recurse rhs)+ TernaryExpr cond thenExpr elseExpr ->+ Fix <$> (TernaryExpr <$> recurse cond <*> recurse thenExpr <*> recurse elseExpr)+ AssignExpr lhs op rhs ->+ Fix <$> (AssignExpr <$> recurse lhs <*> pure op <*> recurse rhs)+ ParenExpr expr ->+ Fix <$> (ParenExpr <$> recurse expr)+ CastExpr ty expr ->+ Fix <$> (CastExpr <$> recurse ty <*> recurse expr)+ CompoundExpr ty expr ->+ Fix <$> (CompoundExpr <$> recurse ty <*> recurse expr)+ SizeofExpr expr ->+ Fix <$> (SizeofExpr <$> recurse expr)+ SizeofType ty ->+ Fix <$> (SizeofType <$> recurse ty)+ LiteralExpr ty value ->+ Fix <$> (LiteralExpr ty <$> recurse value)+ VarExpr name ->+ Fix <$> (VarExpr <$> recurse name)+ MemberAccess name field ->+ Fix <$> (MemberAccess <$> recurse name <*> recurse field)+ PointerAccess name field ->+ Fix <$> (PointerAccess <$> recurse name <*> recurse field)+ ArrayAccess arr idx ->+ Fix <$> (ArrayAccess <$> recurse arr <*> recurse idx)+ FunctionCall callee args ->+ Fix <$> (FunctionCall <$> recurse callee <*> recurse args)+ CommentExpr comment expr ->+ Fix <$> (CommentExpr <$> recurse comment <*> recurse expr)+ EnumConsts name members ->+ Fix <$> (EnumConsts <$> recurse name <*> recurse members)+ EnumDecl name members tyName ->+ Fix <$> (EnumDecl <$> recurse name <*> recurse members <*> recurse tyName)+ Enumerator name value ->+ Fix <$> (Enumerator <$> recurse name <*> recurse value)+ Typedef ty name ->+ Fix <$> (Typedef <$> recurse ty <*> recurse name)+ TypedefFunction ty ->+ Fix <$> (TypedefFunction <$> recurse ty)+ Struct name members ->+ Fix <$> (Struct <$> recurse name <*> recurse members)+ Union name members ->+ Fix <$> (Union <$> recurse name <*> recurse members)+ MemberDecl decl bits ->+ Fix <$> (MemberDecl <$> recurse decl <*> recurse bits)+ TyConst ty ->+ Fix <$> (TyConst <$> recurse ty)+ TyPointer ty ->+ Fix <$> (TyPointer <$> recurse ty)+ TyStruct name ->+ Fix <$> (TyStruct <$> recurse name)+ TyFunc name ->+ Fix <$> (TyFunc <$> recurse name)+ TyStd name ->+ Fix <$> (TyStd <$> recurse name)+ TyUserDefined name ->+ Fix <$> (TyUserDefined <$> recurse name)+ FunctionDecl scope proto ->+ Fix <$> (FunctionDecl scope <$> recurse proto)+ FunctionDefn scope proto body ->+ Fix <$> (FunctionDefn scope <$> recurse proto <*> recurse body)+ FunctionPrototype ty name params ->+ Fix <$> (FunctionPrototype <$> recurse ty <*> recurse name <*> recurse params)+ Ellipsis ->+ pure $ Fix Ellipsis+ ConstDecl ty name ->+ Fix <$> (ConstDecl <$> recurse ty <*> recurse name)+ ConstDefn scope ty name value ->+ Fix <$> (ConstDefn scope <$> recurse ty <*> recurse name <*> recurse value)++ where+ recurse :: MapAst itext otext a => a -> f (Mapped itext otext a)+ recurse = mapFileAst actions currentFile++instance MapAst itext otext [Node (Lexeme itext)] where+ type Mapped itext otext [Node (Lexeme itext)]+ = [Node (Lexeme otext)]+ mapFileAst actions@AstActions{..} currentFile = doNodes currentFile <*>+ traverse (mapFileAst actions currentFile)++instance MapAst itext otext (FilePath, [Node (Lexeme itext)]) where+ type Mapped itext otext (FilePath, [Node (Lexeme itext)])+ = (FilePath, [Node (Lexeme otext)])+ mapFileAst actions@AstActions{..} _ tu@(currentFile, _) = doFile <*>+ traverse (mapFileAst actions currentFile) $ tu++instance MapAst itext otext [(FilePath, [Node (Lexeme itext)])] where+ type Mapped itext otext [(FilePath, [Node (Lexeme itext)])]+ = [(FilePath, [Node (Lexeme otext)])]+ mapFileAst actions@AstActions{..} currentFile = doFiles <*>+ traverse (mapFileAst actions currentFile)
src/Language/Cimple/SemCheck/Includes.hs view
@@ -12,10 +12,10 @@ import qualified Data.Text as Text import Language.Cimple.Ast (NodeF (..)) import Language.Cimple.Lexer (Lexeme (..))+import Language.Cimple.MapAst (IdentityActions, doNode,+ identityActions, mapAst) import Language.Cimple.Tokens (LexemeClass (..)) import Language.Cimple.TranslationUnit (TranslationUnit)-import Language.Cimple.TraverseAst (IdentityActions, doNode,- identityActions, traverseAst) import System.FilePath (joinPath, splitPath, takeDirectory) @@ -59,4 +59,4 @@ normaliseIncludes (file, ast) = ((file, ast'), includes) where- (ast', includes) = State.runState (traverseAst (normaliseIncludes' (takeDirectory file)) ast) []+ (ast', includes) = State.runState (mapAst (normaliseIncludes' (takeDirectory file)) ast) []
src/Language/Cimple/TraverseAst.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -14,265 +15,372 @@ , doLexemes, doLexeme , doText - , astActions- , TextActions, textActions- , IdentityActions, identityActions+ , astActions, AstActions ) where import Data.Fix (Fix (..))+import Data.Foldable (traverse_) import Language.Cimple.Ast (Node, NodeF (..)) import Language.Cimple.Lexer (Lexeme (..)) -class TraverseAst itext otext a where- type Mapped itext otext a- mapFileAst+class TraverseAst text a where+ traverseFileAst :: Applicative f- => AstActions f itext otext+ => AstActions f text -> FilePath -> a- -> f (Mapped itext otext a)+ -> f () traverseAst- :: (TraverseAst itext otext a, Applicative f)- => AstActions f itext otext -> a- -> f (Mapped itext otext a)-traverseAst = flip mapFileAst "<stdin>"+ :: (TraverseAst text a, Applicative f)+ => AstActions f text -> a+ -> f ()+traverseAst = flip traverseFileAst "<stdin>" -data AstActions f itext otext = AstActions- { doFiles :: [(FilePath, [Node (Lexeme itext)])] -> f [(FilePath, [Node (Lexeme otext)])] -> f [(FilePath, [Node (Lexeme otext)])]- , doFile :: (FilePath, [Node (Lexeme itext)]) -> f (FilePath, [Node (Lexeme otext)]) -> f (FilePath, [Node (Lexeme otext)])- , doNodes :: FilePath -> [Node (Lexeme itext)] -> f [Node (Lexeme otext)] -> f [Node (Lexeme otext)]- , doNode :: FilePath -> Node (Lexeme itext) -> f (Node (Lexeme otext)) -> f (Node (Lexeme otext))- , doLexemes :: FilePath -> [Lexeme itext] -> f [Lexeme otext] -> f [Lexeme otext]- , doLexeme :: FilePath -> Lexeme itext -> f (Lexeme otext) -> f (Lexeme otext)- , doText :: FilePath -> itext -> f otext+data AstActions f text = AstActions+ { doFiles :: [(FilePath, [Node (Lexeme text)])] -> f () -> f ()+ , doFile :: (FilePath, [Node (Lexeme text)]) -> f () -> f ()+ , doNodes :: FilePath -> [Node (Lexeme text)] -> f () -> f ()+ , doNode :: FilePath -> Node (Lexeme text) -> f () -> f ()+ , doLexemes :: FilePath -> [Lexeme text] -> f () -> f ()+ , doLexeme :: FilePath -> Lexeme text -> f () -> f ()+ , doText :: FilePath -> text -> f () } -instance TraverseAst itext otext a- => TraverseAst itext otext (Maybe a) where- type Mapped itext otext (Maybe a)- = Maybe (Mapped itext otext a)- mapFileAst _ _ Nothing = pure Nothing- mapFileAst actions currentFile (Just x) = Just <$> mapFileAst actions currentFile x+instance TraverseAst text a+ => TraverseAst text (Maybe a) where+ traverseFileAst _ _ _ = pure () astActions :: Applicative f- => (itext -> f otext)- -> AstActions f itext otext-astActions ft = AstActions+ => AstActions f text+astActions = AstActions { doFiles = const id , doFile = const id , doNodes = const $ const id , doNode = const $ const id , doLexeme = const $ const id , doLexemes = const $ const id- , doText = const ft+ , doText = const $ const $ pure () } -type TextActions f itext otext = AstActions f itext otext-textActions :: Applicative f => (itext -> f otext) -> TextActions f itext otext-textActions = astActions -type IdentityActions f text = AstActions f text text-identityActions :: Applicative f => AstActions f text text-identityActions = astActions pure---instance TraverseAst itext otext (Lexeme itext) where- type Mapped itext otext (Lexeme itext)- = Lexeme otext- mapFileAst :: forall f . Applicative f- => AstActions f itext otext -> FilePath -> Lexeme itext -> f (Lexeme otext)- mapFileAst AstActions{..} currentFile = doLexeme currentFile <*>- \(L p c s) -> L p c <$> doText currentFile s+instance TraverseAst text (Lexeme text) where+ traverseFileAst :: forall f . Applicative f+ => AstActions f text -> FilePath -> Lexeme text -> f ()+ traverseFileAst AstActions{..} currentFile = doLexeme currentFile <*>+ \(L _ _ s) -> doText currentFile s -instance TraverseAst itext otext [Lexeme itext] where- type Mapped itext otext [Lexeme itext]- = [Lexeme otext]- mapFileAst actions@AstActions{..} currentFile = doLexemes currentFile <*>- traverse (mapFileAst actions currentFile)+instance TraverseAst text [Lexeme text] where+ traverseFileAst actions@AstActions{..} currentFile = doLexemes currentFile <*>+ traverse_ (traverseFileAst actions currentFile) -instance TraverseAst itext otext (Node (Lexeme itext)) where- type Mapped itext otext (Node (Lexeme itext))- = Node (Lexeme otext)- mapFileAst+instance TraverseAst text (Node (Lexeme text)) where+ traverseFileAst :: forall f . Applicative f- => AstActions f itext otext+ => AstActions f text -> FilePath- -> Node (Lexeme itext)- -> f (Node (Lexeme otext))- mapFileAst actions@AstActions{..} currentFile = doNode currentFile <*> \node -> case unFix node of- PreprocInclude path ->- Fix <$> (PreprocInclude <$> recurse path)- PreprocDefine name ->- Fix <$> (PreprocDefine <$> recurse name)- PreprocDefineConst name value ->- Fix <$> (PreprocDefineConst <$> recurse name <*> recurse value)- PreprocDefineMacro name params body ->- Fix <$> (PreprocDefineMacro <$> recurse name <*> recurse params <*> recurse body)- PreprocIf cond thenDecls elseBranch ->- Fix <$> (PreprocIf <$> recurse cond <*> recurse thenDecls <*> recurse elseBranch)- PreprocIfdef name thenDecls elseBranch ->- Fix <$> (PreprocIfdef <$> recurse name <*> recurse thenDecls <*> recurse elseBranch)- PreprocIfndef name thenDecls elseBranch ->- Fix <$> (PreprocIfndef <$> recurse name <*> recurse thenDecls <*> recurse elseBranch)- PreprocElse decls ->- Fix <$> (PreprocElse <$> recurse decls)- PreprocElif cond decls elseBranch ->- Fix <$> (PreprocElif <$> recurse cond <*> recurse decls <*> recurse elseBranch)- PreprocUndef name ->- Fix <$> (PreprocUndef <$> recurse name)- PreprocDefined name ->- Fix <$> (PreprocDefined <$> recurse name)- PreprocScopedDefine define stmts undef ->- Fix <$> (PreprocScopedDefine <$> recurse define <*> recurse stmts <*> recurse undef)- MacroBodyStmt stmts ->- Fix <$> (MacroBodyStmt <$> recurse stmts)- MacroBodyFunCall expr ->- Fix <$> (MacroBodyFunCall <$> recurse expr)- MacroParam name ->- Fix <$> (MacroParam <$> recurse name)- StaticAssert cond msg ->- Fix <$> (StaticAssert <$> recurse cond <*> recurse msg)- LicenseDecl license copyrights ->- Fix <$> (LicenseDecl <$> recurse license <*> recurse copyrights)- CopyrightDecl from to owner ->- Fix <$> (CopyrightDecl <$> recurse from <*> recurse to <*> recurse owner)- Comment doc start contents end ->- Fix <$> (Comment doc <$> recurse start <*> recurse contents <*> recurse end)- CommentBlock comment ->- Fix <$> (CommentBlock <$> recurse comment)- Commented comment subject ->- Fix <$> (Commented <$> recurse comment <*> recurse subject)- ExternC decls ->- Fix <$> (ExternC <$> recurse decls)- CompoundStmt stmts ->- Fix <$> (CompoundStmt <$> recurse stmts)+ -> Node (Lexeme text)+ -> f ()+ traverseFileAst actions@AstActions{..} currentFile = doNode currentFile <*> \node -> case unFix node of+ PreprocInclude path -> do+ _ <- recurse path+ pure ()+ PreprocDefine name -> do+ _ <- recurse name+ pure ()+ PreprocDefineConst name value -> do+ _ <- recurse name+ _ <- recurse value+ pure ()+ PreprocDefineMacro name params body -> do+ _ <- recurse name+ _ <- recurse params+ _ <- recurse body+ pure ()+ PreprocIf cond thenDecls elseBranch -> do+ _ <- recurse cond+ _ <- recurse thenDecls+ _ <- recurse elseBranch+ pure ()+ PreprocIfdef name thenDecls elseBranch -> do+ _ <- recurse name+ _ <- recurse thenDecls+ _ <- recurse elseBranch+ pure ()+ PreprocIfndef name thenDecls elseBranch -> do+ _ <- recurse name+ _ <- recurse thenDecls+ _ <- recurse elseBranch+ pure ()+ PreprocElse decls -> do+ _ <- recurse decls+ pure ()+ PreprocElif cond decls elseBranch -> do+ _ <- recurse cond+ _ <- recurse decls+ _ <- recurse elseBranch+ pure ()+ PreprocUndef name -> do+ _ <- recurse name+ pure ()+ PreprocDefined name -> do+ _ <- recurse name+ pure ()+ PreprocScopedDefine define stmts undef -> do+ _ <- recurse define+ _ <- recurse stmts+ _ <- recurse undef+ pure ()+ MacroBodyStmt stmts -> do+ _ <- recurse stmts+ pure ()+ MacroBodyFunCall expr -> do+ _ <- recurse expr+ pure ()+ MacroParam name -> do+ _ <- recurse name+ pure ()+ StaticAssert cond msg -> do+ _ <- recurse cond+ _ <- recurse msg+ pure ()+ LicenseDecl license copyrights -> do+ _ <- recurse license+ _ <- recurse copyrights+ pure ()+ CopyrightDecl from to owner -> do+ _ <- recurse from+ _ <- recurse to+ _ <- recurse owner+ pure ()+ Comment _doc start contents end -> do+ _ <- recurse start+ _ <- recurse contents+ _ <- recurse end+ pure ()+ CommentBlock comment -> do+ _ <- recurse comment+ pure ()+ Commented comment subject -> do+ _ <- recurse comment+ _ <- recurse subject+ pure ()+ ExternC decls -> do+ _ <- recurse decls+ pure ()+ CompoundStmt stmts -> do+ _ <- recurse stmts+ pure () Break ->- pure $ Fix Break- Goto label ->- Fix <$> (Goto <$> recurse label)+ pure ()+ Goto label -> do+ _ <- recurse label+ pure () Continue ->- pure $ Fix Continue- Return value ->- Fix <$> (Return <$> recurse value)- SwitchStmt value cases ->- Fix <$> (SwitchStmt <$> recurse value <*> recurse cases)- IfStmt cond thenStmts elseStmt ->- Fix <$> (IfStmt <$> recurse cond <*> recurse thenStmts <*> recurse elseStmt)- ForStmt initStmt cond next stmts ->- Fix <$> (ForStmt <$> recurse initStmt <*> recurse cond <*> recurse next <*> recurse stmts)- WhileStmt cond stmts ->- Fix <$> (WhileStmt <$> recurse cond <*> recurse stmts)- DoWhileStmt stmts cond ->- Fix <$> (DoWhileStmt <$> recurse stmts <*> recurse cond)- Case value stmt ->- Fix <$> (Case <$> recurse value <*> recurse stmt)- Default stmt ->- Fix <$> (Default <$> recurse stmt)- Label label stmt ->- Fix <$> (Label <$> recurse label <*> recurse stmt)- VLA ty name size ->- Fix <$> (VLA <$> recurse ty <*> recurse name <*> recurse size)- VarDeclStmt decl ini ->- Fix <$> (VarDeclStmt <$> recurse decl <*> recurse ini)- VarDecl ty name arrs ->- Fix <$> (VarDecl <$> recurse ty <*> recurse name <*> recurse arrs)- DeclSpecArray size ->- Fix <$> (DeclSpecArray <$> recurse size)- InitialiserList values ->- Fix <$> (InitialiserList <$> recurse values)- UnaryExpr op expr ->- Fix <$> (UnaryExpr op <$> recurse expr)- BinaryExpr lhs op rhs ->- Fix <$> (BinaryExpr <$> recurse lhs <*> pure op <*> recurse rhs)- TernaryExpr cond thenExpr elseExpr ->- Fix <$> (TernaryExpr <$> recurse cond <*> recurse thenExpr <*> recurse elseExpr)- AssignExpr lhs op rhs ->- Fix <$> (AssignExpr <$> recurse lhs <*> pure op <*> recurse rhs)- ParenExpr expr ->- Fix <$> (ParenExpr <$> recurse expr)- CastExpr ty expr ->- Fix <$> (CastExpr <$> recurse ty <*> recurse expr)- CompoundExpr ty expr ->- Fix <$> (CompoundExpr <$> recurse ty <*> recurse expr)- SizeofExpr expr ->- Fix <$> (SizeofExpr <$> recurse expr)- SizeofType ty ->- Fix <$> (SizeofType <$> recurse ty)- LiteralExpr ty value ->- Fix <$> (LiteralExpr ty <$> recurse value)- VarExpr name ->- Fix <$> (VarExpr <$> recurse name)- MemberAccess name field ->- Fix <$> (MemberAccess <$> recurse name <*> recurse field)- PointerAccess name field ->- Fix <$> (PointerAccess <$> recurse name <*> recurse field)- ArrayAccess arr idx ->- Fix <$> (ArrayAccess <$> recurse arr <*> recurse idx)- FunctionCall callee args ->- Fix <$> (FunctionCall <$> recurse callee <*> recurse args)- CommentExpr comment expr ->- Fix <$> (CommentExpr <$> recurse comment <*> recurse expr)- EnumConsts name members ->- Fix <$> (EnumConsts <$> recurse name <*> recurse members)- EnumDecl name members tyName ->- Fix <$> (EnumDecl <$> recurse name <*> recurse members <*> recurse tyName)- Enumerator name value ->- Fix <$> (Enumerator <$> recurse name <*> recurse value)- Typedef ty name ->- Fix <$> (Typedef <$> recurse ty <*> recurse name)- TypedefFunction ty ->- Fix <$> (TypedefFunction <$> recurse ty)- Struct name members ->- Fix <$> (Struct <$> recurse name <*> recurse members)- Union name members ->- Fix <$> (Union <$> recurse name <*> recurse members)- MemberDecl decl bits ->- Fix <$> (MemberDecl <$> recurse decl <*> recurse bits)- TyConst ty ->- Fix <$> (TyConst <$> recurse ty)- TyPointer ty ->- Fix <$> (TyPointer <$> recurse ty)- TyStruct name ->- Fix <$> (TyStruct <$> recurse name)- TyFunc name ->- Fix <$> (TyFunc <$> recurse name)- TyStd name ->- Fix <$> (TyStd <$> recurse name)- TyUserDefined name ->- Fix <$> (TyUserDefined <$> recurse name)- FunctionDecl scope proto ->- Fix <$> (FunctionDecl scope <$> recurse proto)- FunctionDefn scope proto body ->- Fix <$> (FunctionDefn scope <$> recurse proto <*> recurse body)- FunctionPrototype ty name params ->- Fix <$> (FunctionPrototype <$> recurse ty <*> recurse name <*> recurse params)+ pure ()+ Return value -> do+ _ <- recurse value+ pure ()+ SwitchStmt value cases -> do+ _ <- recurse value+ _ <- recurse cases+ pure ()+ IfStmt cond thenStmts elseStmt -> do+ _ <- recurse cond+ _ <- recurse thenStmts+ _ <- recurse elseStmt+ pure ()+ ForStmt initStmt cond next stmts -> do+ _ <- recurse initStmt+ _ <- recurse cond+ _ <- recurse next+ _ <- recurse stmts+ pure ()+ WhileStmt cond stmts -> do+ _ <- recurse cond+ _ <- recurse stmts+ pure ()+ DoWhileStmt stmts cond -> do+ _ <- recurse stmts+ _ <- recurse cond+ pure ()+ Case value stmt -> do+ _ <- recurse value+ _ <- recurse stmt+ pure ()+ Default stmt -> do+ _ <- recurse stmt+ pure ()+ Label label stmt -> do+ _ <- recurse label+ _ <- recurse stmt+ pure ()+ VLA ty name size -> do+ _ <- recurse ty+ _ <- recurse name+ _ <- recurse size+ pure ()+ VarDeclStmt decl ini -> do+ _ <- recurse decl+ _ <- recurse ini+ pure ()+ VarDecl ty name arrs -> do+ _ <- recurse ty+ _ <- recurse name+ _ <- recurse arrs+ pure ()+ DeclSpecArray size -> do+ _ <- recurse size+ pure ()+ InitialiserList values -> do+ _ <- recurse values+ pure ()+ UnaryExpr _op expr -> do+ _ <- recurse expr+ pure ()+ BinaryExpr lhs _op rhs -> do+ _ <- recurse lhs+ _ <- recurse rhs+ pure ()+ TernaryExpr cond thenExpr elseExpr -> do+ _ <- recurse cond+ _ <- recurse thenExpr+ _ <- recurse elseExpr+ pure ()+ AssignExpr lhs _op rhs -> do+ _ <- recurse lhs+ _ <- recurse rhs+ pure ()+ ParenExpr expr -> do+ _ <- recurse expr+ pure ()+ CastExpr ty expr -> do+ _ <- recurse ty+ _ <- recurse expr+ pure ()+ CompoundExpr ty expr -> do+ _ <- recurse ty+ _ <- recurse expr+ pure ()+ SizeofExpr expr -> do+ _ <- recurse expr+ pure ()+ SizeofType ty -> do+ _ <- recurse ty+ pure ()+ LiteralExpr _ty value -> do+ _ <- recurse value+ pure ()+ VarExpr name -> do+ _ <- recurse name+ pure ()+ MemberAccess name field -> do+ _ <- recurse name+ _ <- recurse field+ pure ()+ PointerAccess name field -> do+ _ <- recurse name+ _ <- recurse field+ pure ()+ ArrayAccess arr idx -> do+ _ <- recurse arr+ _ <- recurse idx+ pure ()+ FunctionCall callee args -> do+ _ <- recurse callee+ _ <- recurse args+ pure ()+ CommentExpr comment expr -> do+ _ <- recurse comment+ _ <- recurse expr+ pure ()+ EnumConsts name members -> do+ _ <- recurse name+ _ <- recurse members+ pure ()+ EnumDecl name members tyName -> do+ _ <- recurse name+ _ <- recurse members+ _ <- recurse tyName+ pure ()+ Enumerator name value -> do+ _ <- recurse name+ _ <- recurse value+ pure ()+ Typedef ty name -> do+ _ <- recurse ty+ _ <- recurse name+ pure ()+ TypedefFunction ty -> do+ _ <- recurse ty+ pure ()+ Struct name members -> do+ _ <- recurse name+ _ <- recurse members+ pure ()+ Union name members -> do+ _ <- recurse name+ _ <- recurse members+ pure ()+ MemberDecl decl bits -> do+ _ <- recurse decl+ _ <- recurse bits+ pure ()+ TyConst ty -> do+ _ <- recurse ty+ pure ()+ TyPointer ty -> do+ _ <- recurse ty+ pure ()+ TyStruct name -> do+ _ <- recurse name+ pure ()+ TyFunc name -> do+ _ <- recurse name+ pure ()+ TyStd name -> do+ _ <- recurse name+ pure ()+ TyUserDefined name -> do+ _ <- recurse name+ pure ()+ FunctionDecl _scope proto -> do+ _ <- recurse proto+ pure ()+ FunctionDefn _scope proto body -> do+ _ <- recurse proto+ _ <- recurse body+ pure ()+ FunctionPrototype ty name params -> do+ _ <- recurse ty+ _ <- recurse name+ _ <- recurse params+ pure () Ellipsis ->- pure $ Fix Ellipsis- ConstDecl ty name ->- Fix <$> (ConstDecl <$> recurse ty <*> recurse name)- ConstDefn scope ty name value ->- Fix <$> (ConstDefn scope <$> recurse ty <*> recurse name <*> recurse value)+ pure ()+ ConstDecl ty name -> do+ _ <- recurse ty+ _ <- recurse name+ pure ()+ ConstDefn _scope ty name value -> do+ _ <- recurse ty+ _ <- recurse name+ _ <- recurse value+ pure () where- recurse :: TraverseAst itext otext a => a -> f (Mapped itext otext a)- recurse = mapFileAst actions currentFile+ recurse :: TraverseAst text a => a -> f ()+ recurse = traverseFileAst actions currentFile -instance TraverseAst itext otext [Node (Lexeme itext)] where- type Mapped itext otext [Node (Lexeme itext)]- = [Node (Lexeme otext)]- mapFileAst actions@AstActions{..} currentFile = doNodes currentFile <*>- traverse (mapFileAst actions currentFile)+instance TraverseAst text [Node (Lexeme text)] where+ traverseFileAst actions@AstActions{..} currentFile = doNodes currentFile <*>+ traverse_ (traverseFileAst actions currentFile) -instance TraverseAst itext otext (FilePath, [Node (Lexeme itext)]) where- type Mapped itext otext (FilePath, [Node (Lexeme itext)])- = (FilePath, [Node (Lexeme otext)])- mapFileAst actions@AstActions{..} _ tu@(currentFile, _) = doFile <*>- traverse (mapFileAst actions currentFile) $ tu+instance TraverseAst text (FilePath, [Node (Lexeme text)]) where+ traverseFileAst actions@AstActions{..} _ tu@(currentFile, _) = doFile <*>+ traverse_ (traverseFileAst actions currentFile) $ tu -instance TraverseAst itext otext [(FilePath, [Node (Lexeme itext)])] where- type Mapped itext otext [(FilePath, [Node (Lexeme itext)])]- = [(FilePath, [Node (Lexeme otext)])]- mapFileAst actions@AstActions{..} currentFile = doFiles <*>- traverse (mapFileAst actions currentFile)+instance TraverseAst text [(FilePath, [Node (Lexeme text)])] where+ traverseFileAst actions@AstActions{..} currentFile = doFiles <*>+ traverse_ (traverseFileAst actions currentFile)