packages feed

cparsing (empty) → 0.1.0.0

raw patch · 41 files changed

+4705/−0 lines, 41 filesdep +HUnitdep +basedep +containerssetup-changed

Dependencies added: HUnit, base, containers, directory, either, filepath, lens, mtl, parsec, split, template-haskell, transformers

Files

+ CTransform.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, NamedFieldPuns, LambdaCase, ViewPatterns
+           , FlexibleContexts, TemplateHaskell, RankNTypes #-}
+
+-- | Reimplementation of Remix-C transformation program.
+module CTransform where
+
+import MiniC.ParseProgram
+import MiniC.Representation
+import MiniC.AST
+import MiniC.PrettyPrint
+import MiniC.GenTemplate
+import MiniC.SourceNotation
+import MiniC.RangeTree
+import MiniC.Semantics
+import MiniC.Helpers
+import MiniC.SymbolTable
+import MiniC.TransformInfo
+import MiniC.Instances
+
+import SourceCode.ASTElems
+import SourceCode.ToSourceTree
+import SourceCode.ASTNode
+
+import Control.Monad
+import Control.Lens hiding ((<.>))
+import Control.Lens.Plated
+import Data.Data.Lens
+import Data.Function
+import Data.Maybe
+import Data.Either.Combinators
+import Control.Applicative
+import System.Environment
+import System.Directory
+import System.FilePath
+import Debug.Trace
+
+main :: IO ()
+main = do (file:trfs) <- getArgs
+          wd <- getCurrentDirectory
+          transforms <- parseTrfs trfs
+          runProgram (ProgramParams file transforms) >>= \case
+            Right prog -> writeFile (modifiedFileName transforms file) (prettyPrint prog)
+            Left err -> putStrLn err
+          
+runProgram :: ProgramParams -> IO (Either String TranslationUnitNI)
+runProgram (ProgramParams file transforms) =
+  readFile file
+    >>= parseProgram file
+    >>= return 
+         . mapBoth show
+                   ( flip transformAST transforms 
+                      . analyseAST
+                      . transformSourceInfo )
+                   
+       
+data ProgramParams 
+  = ProgramParams { _inputFile :: String 
+                  , _transformations :: [Transformation]
+                  }
+  deriving (Show)
+        
+-- | Transformations that the tool can produce
+data Transformation = IntroduceIndirection QualifiedName
+                    | RemoveIndirection QualifiedName
+                    | CreateSkeleton
+  deriving Show
+        
+-- | Parses command line arguments
+parseTrfs :: [String] -> IO [Transformation]
+parseTrfs ("-ri":qname:rest) 
+  = (:) <$> (RemoveIndirection <$> parseQualName qname) <*> parseTrfs rest
+parseTrfs ("-ii":qname:rest) 
+  = (:) <$> (IntroduceIndirection <$> parseQualName qname) <*> parseTrfs rest
+parseTrfs ("-cc":rest) 
+  = (CreateSkeleton :) <$> parseTrfs rest
+parseTrfs [] = return []
+-- handle command line errors
+parseTrfs (tr:_) | tr `elem` ["-ri","-ii"] 
+  = error ("Not enough parameters for transformation " ++ tr) 
+parseTrfs (command:_) = error $ "Unknown command: " ++ command
+  
+-- | Produces the name of the transformed file
+modifiedFileName :: [Transformation] -> FilePath -> FilePath
+modifiedFileName [CreateSkeleton]   = addPlusExtension "skeleton"
+modifiedFileName _                  = addPlusExtension "configured" 
+
+-- | Adds a new extensions before an existing one
+addPlusExtension ext fn 
+  = dropExtensions fn <.> ext <.> takeExtensions fn
+     
+transformAST :: TranslationUnitNI -> [Transformation] -> TranslationUnitNI
+transformAST = foldl doTrfAST 
+  where doTrfAST :: TranslationUnitNI -> Transformation -> TranslationUnitNI
+        doTrfAST tu (RemoveIndirection name) = removeIndirection name tu
+        doTrfAST tu (IntroduceIndirection name) = addIndirection name tu
+        doTrfAST tu CreateSkeleton = createSkeleton tu
+                                                
+addIndirection :: QualifiedName -> TranslationUnitNI -> TranslationUnitNI
+addIndirection qn tu
+  = let declaration :: Simple Traversal TranslationUnitNI VariableDeclarationNI
+        declaration = biplate . checkScope qn . filterTrav (has (matchQualItself qn)) simple
+        exprs = biplate :: Simple Traversal TranslationUnitNI ExpressionNI
+     in case toListOf declaration tu of
+          [] -> error "No matching declaration for adding indirection"
+          [_] -> over exprs trfExpr $ over declaration trfDecl tu
+          _ -> error "Multiple matching declarations for adding indirection"
+     
+  where -- | Add indirection to a declaration
+        trfDecl :: VariableDeclarationNI -> VariableDeclarationNI
+        trfDecl vd = vd & matchQualItself qn %~ (addPtrToQual (vd ^? matchParentQual qn))
+  
+        trfExpr :: ExpressionNI -> ExpressionNI
+        trfExpr memb@(Member{}) 
+          | toTrf qn (memb ^?! exprBase)
+             && (case memb ^?! exprMemberDeref of SimpleMember {} -> True; _ -> False)
+          = memb & exprMemberDeref .~ genMemberDeref
+        trfExpr name 
+          | toTrf qn name
+          = genDerefExpr name
+        trfExpr other 
+          = over uniplate trfExpr other
+        
+-- | Match the parent or the qualifier itself where changes need to be done
+matchParentQual, matchQualItself :: QualifiedName -> Simple Traversal VariableDeclarationNI TypeQualifierNI
+matchParentQual qn = varDeclQualTyp . qualTypQual . matchQualParent (qn ^. qnTypeQual)
+matchQualItself qn = varDeclQualTyp . qualTypQual . matchQual (qn ^. qnTypeQual)
+  
+        
+createSizeOfQual :: QualifiedTypeNI -> ExpressionNI
+createSizeOfQual = undefined
+        
+-- | Removes indirection 
+removeIndirection :: QualifiedName -> TranslationUnitNI -> TranslationUnitNI
+removeIndirection qn tu
+  = let declaration :: Simple Traversal TranslationUnitNI VariableDeclarationNI
+        declaration = biplate . checkScope qn . filterTrav (has (matchQualItself qn)) simple
+        exprs = biplate :: Simple Traversal TranslationUnitNI ExpressionNI
+     in case toListOf declaration tu of
+          [] -> error "No matching declaration for removing indirection"
+          [_] -> over exprs trfExpr $ over declaration trfDecl tu
+          _ -> error "Multiple matching declarations for removing indirection"
+      
+  where trfDecl :: VariableDeclarationNI -> VariableDeclarationNI
+        trfDecl vd = vd & matchQualItself qn %~ (removePtrFromQual (vd ^? matchParentQual qn))
+        
+        trfExpr :: ExpressionNI -> ExpressionNI
+        trfExpr memb@(Member{})
+          | case memb ^?! exprMemberDeref of 
+              DerefMember {} -> fmap (view qnTypeQual) (getQualName (memb ^?! exprBase))
+                                  == Just (removePtrFromQual Nothing (qn ^. qnTypeQual))
+              SimpleMember {} -> False
+          = memb & exprMemberDeref .~ genMemberSimple
+        trfExpr un 
+          | Just (DereferenceOp {}) <- un ^? exprUnaryOp
+          , Just name <- un ^? exprOperand
+          , toTrf qn un
+          = name
+        trfExpr other 
+          = over uniplate trfExpr other
+      
+
+-- | Check that the element is in the scope we search for
+checkScope qn = filterTrav (((==) `on` view qnScope . simplifyQualName) qn) 
+                           (info.semanticInfo.declQualName._Just) 
+    
+-- | Check that the elem is the element we want to transform
+toTrf qn elem 
+  | Just qualName <- getQualName elem
+    = simplifyQualName qualName == simplifyQualName qn
+  | otherwise 
+    = False
+            
+getQualName elem = (join (elem ^? info.semanticInfo.referenceQualName)
+                       <|> join (elem ^? info.semanticInfo.declQualName))
+        
+-- | Creates a skeleton file, a file where only declarations are kept.
+createSkeleton :: TranslationUnitNI -> TranslationUnitNI
+createSkeleton = transformOn (biplate :: Simple Traversal TranslationUnitNI StatementNI) 
+                             removeStatements
+  where removeStatements :: StatementNI -> StatementNI
+        removeStatements 
+          = compoundStmts %~ astFilter hasDeclaration
+          
+        hasDeclaration :: ASTEitherNI Declaration Statement 
+                            -> Maybe (ASTEitherNI Declaration Statement)
+        hasDeclaration (ASTLeft d) = Just (ASTLeft d)
+        hasDeclaration (ASTRight stmt) 
+          = if null (universeOn (biplate :: Simple Traversal StatementNI DeclarationNI) stmt) 
+              then Nothing 
+              else Just (ASTRight (transform removeStatements stmt)) 
+        
+
+-- | Propagates additional information in the syntax tree
+analyseAST :: TranslationUnitNI -> TranslationUnitNI
+analyseAST = transformOn (biplate :: Simple Traversal TranslationUnitNI ExpressionNI)
+                         additionalScopes
+  where additionalScopes expr@(Unary {}) 
+          | Just (DereferenceOp {}) <- expr ^? exprUnaryOp
+          , Just (Just qn) <- expr ^? exprOperand.refName
+            = expr & refName %~ (<|> Just (qn & qnTypeQual %~ addPtrToQual Nothing))
+        additionalScopes expr@(Indexing {})
+          | Just (Just qn) <- expr ^? exprBase.refName
+            = expr & refName %~ (<|> Just (qn & qnTypeQual %~ genArrayQual ))
+        additionalScopes expr@(NameExpr {})
+          | Just qn <- expr ^? exprIdent.refName
+            = expr & refName %~ (<|> qn)
+        -- additionalScopes expr@(Member {})
+          -- | Just qn <- expr ^? exprBase.refName
+          -- , Just deref <- expr ^? exprMemberDeref
+            -- = expr & refName %~ (<|> Just (qn & qnTypeQual %~ case deref of DerefMember {} -> addPtrToQual Nothing
+                                                                            -- SimpleMember {} -> id))
+        additionalScopes expr@(ParenExpr {})
+          | Just qn <- expr ^? parenExpr.refName
+            = expr & refName %~ (<|> qn)
+        additionalScopes expr = expr
+          
+        refName :: ASTNode node NI => Lens' (node NI) (Maybe QualifiedName)
+        refName = info.semanticInfo.referenceQualName
+        
+$(makeLenses ''ProgramParams)
+
+
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for cparsing
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
+ Data/SmartTrav.hs view
@@ -0,0 +1,9 @@+module Data.SmartTrav 
+( module Data.SmartTrav.Class
+, module Data.SmartTrav.Instances
+, deriveSmartTrav 
+) where
+
+import Data.SmartTrav.Class
+import Data.SmartTrav.Instances
+import Data.SmartTrav.TH
+ Data/SmartTrav/Class.hs view
@@ -0,0 +1,7 @@+module Data.SmartTrav.Class where
+
+import Control.Applicative
+ 
+class SmartTrav t where
+  smartTrav :: Applicative f => f () -> f () -> (a -> f b) -> t a -> f (t b)
+
+ Data/SmartTrav/Example.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE StandaloneDeriving, TemplateHaskell, FlexibleContexts #-}
+module Data.SmartTrav.Example where
+
+import Data.SmartTrav.Class
+import Data.SmartTrav.Instances
+import Data.SmartTrav.TH
+import Data.SmartTrav.Indexing
+import Control.Applicative
+
+
+data Lit a = IntLit Integer a
+     deriving (Show)
+
+data Expr a = LitExpr (Lit a) 
+            | Variable String a
+            | Neg (Expr a) a
+            | Plus (Expr a) (Expr a) a
+     deriving (Show)
+     
+data Instr a = Assign (Expr a) (Expr a) a
+             | Sequence (ASTList Instr a)
+     deriving (Show) 
+     
+data Decl a = Procedure String (Instr a) a 
+     deriving (Show)
+
+data ASTList e a 
+  = ASTList { _listElems     :: [e a]
+            , _listInfo      :: a 
+            }
+deriving instance (Show a, Show (e a)) => Show (ASTList e a)
+     
+data ASTMaybe n a
+  = ASTJust  { _astJust      :: n a }
+  | ASTNothing
+deriving instance (Show a, Show (e a)) => Show (ASTMaybe e a)
+  
+program1 = Procedure "program1" (Sequence (ASTList 
+             [ Assign (Variable "a" ()) (LitExpr (IntLit 1 ())) ()
+             , Assign (Variable "v" ()) (Plus (Variable "b" ()) 
+                                        (LitExpr (IntLit 2 ())) ()) ()
+             ] ())) ()
+     
+deriveSmartTrav ''Lit
+deriveSmartTrav ''Expr
+deriveSmartTrav ''Instr
+deriveSmartTrav ''Decl
+deriveSmartTrav ''ASTList
+deriveSmartTrav ''ASTMaybe
+
+-- $(thExamine [d| 
+    -- instance SmartTrav e => SmartTrav (ASTList e) where 
+      -- smartTrav desc asc f (ASTList elems info) 
+        -- = ASTList 
+           -- <$> (desc *> smartTrav desc asc (smartTrav desc asc f) elems <* asc)
+           -- <*> f info  
+ -- |])
+
+     
+test = indexedTraverse (\_ i -> i) program1
+
+ Data/SmartTrav/Indexing.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE LambdaCase #-}
+module Data.SmartTrav.Indexing where
+
+import Data.SmartTrav.Class
+import Control.Monad.State
+import Control.Applicative
+
+indexedTraverse :: SmartTrav t => (a -> [Int] -> b) -> t a -> t b
+indexedTraverse f
+  = flip evalState ([], 0) 
+      . smartTrav ( modify (\(st   ,i) -> (i:st ,0)) )
+                  ( modify (\(s:st ,_) -> (st   ,s)) ) 
+                  ( \a -> f a <$> gets fst <* modify ( \case (s:st,i) -> ((s+1):st,i)
+                                                             ([]  ,i) -> ([]      ,i) ) )
+                        
+
+ Data/SmartTrav/Instances.hs view
@@ -0,0 +1,8 @@+module Data.SmartTrav.Instances where
+
+import Data.SmartTrav.Class
+import Control.Applicative
+import Data.Traversable
+ 
+instance SmartTrav [] where
+  smartTrav _ _ = traverse
+ Data/SmartTrav/TH.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE LambdaCase #-}
+
+module Data.SmartTrav.TH where
+  
+import Language.Haskell.TH
+import Data.Maybe
+import Control.Monad
+import Control.Applicative
+  
+-- | Derive SmartTrav
+deriveSmartTrav :: Name -> Q [Dec]
+deriveSmartTrav nm = reify nm >>= (\case
+  TyConI dt -> case dt of
+    DataD _ tyConName typArgs _ dataCons _ -> 
+      createInstance tyConName typArgs dataCons  
+    NewtypeD _ tyConName typArgs _ dataCon _ -> 
+      createInstance tyConName typArgs [dataCon]  
+    _ -> fail "Unsupported data type"
+  _ -> fail "Expected the name of a data type or newtype"
+  )
+  
+createInstance :: Name -> [TyVarBndr] -> [Con] -> Q [Dec]
+createInstance tyConName typArgs dataCons   
+          = do (clauses, preds) <- unzip <$> mapM createClause dataCons
+               return [InstanceD Nothing (concat preds) 
+                                 (AppT (ConT className) 
+                                   (foldl AppT (ConT tyConName) 
+                                          (map getTypVarTyp (init typArgs))))
+                                 [FunD funName clauses]
+                      ]
+  where  -- | Gets the variable that is traversed on
+        varToTraverseOn :: Q Name
+        varToTraverseOn = case reverse typArgs of 
+          (PlainTV last : _)        -> return last
+          (KindedTV last StarT : _) -> return last
+          (KindedTV last _ : _)     -> fail $ "The kind of the last type parameter is not *"
+          []                        -> fail $ "The kind of type " ++ show tyConName ++ " is *"
+  
+        -- | Creates a clause for a constructor, the needed context is also generated
+        createClause :: Con -> Q (Clause,[Pred])
+        createClause (RecC conName conArgs) 
+          = createClause' conName (map (\(_,_,r) -> r) conArgs)
+        createClause (NormalC conName conArgs) 
+          = createClause' conName (map snd conArgs)
+        
+        createClause' conName argTypes
+          = do bindedNames <- replicateM (length argTypes) (newName "p")
+               (handleParams,ctx) <- unzip <$> zipWithM processParam
+                                                        bindedNames argTypes
+               return $ (Clause [ VarP desc, VarP asc, VarP f
+                               , ConP conName (map VarP bindedNames) ] 
+                               (NormalB (createExpr conName handleParams)) []
+                        , concat ctx)
+
+
+        -- | Creates an expression for the body of a smartTrav clause
+        -- using the matches created for parameters
+        createExpr :: Name -> [Exp] -> Exp
+        createExpr ctrName []
+          = AppE applPure $ ConE ctrName
+        createExpr ctrName (param1:params)
+          = foldl (\coll new -> InfixE (Just coll) applStar (Just new)) 
+                  (InfixE (Just $ ConE ctrName) applDollar (Just param1))
+                  params
+        
+        applStar = VarE (mkName "Control.Applicative.<*>")
+        applStarR = VarE (mkName "Control.Applicative.*>")
+        applStarL = VarE (mkName "Control.Applicative.<*")
+        applDollar = VarE (mkName "Control.Applicative.<$>")
+        applPure = VarE (mkName "Control.Applicative.pure")
+        
+        className = mkName "SmartTrav"
+        funName = mkName "smartTrav"
+        desc = mkName "desc"
+        asc = mkName "asc"
+        f = mkName "f"
+       
+        -- | Creates the expression and the predicate for a parameter
+        processParam :: Name -> Type -> Q (Exp, [Pred])
+        processParam name (VarT v)  -- found the type variable to traverse on
+          = do travV <- varToTraverseOn 
+               if v == travV then return (AppE (VarE f) (VarE name), [])
+                             else return (AppE applPure (VarE name), [])
+        processParam name (AppT tf ta) = do
+          expr <- createExprForHighKind' name (VarE f) ta
+          case expr of Just (e,ctx) -> return (e, if isTypVar tf then AppT (ConT className) tf : ctx
+                                                                 else ctx)
+                       Nothing -> return (AppE applPure (VarE name), [])
+        processParam name _
+          = return (AppE applPure (VarE name), [])
+  
+        -- | Create an expression and a context for a higher kinded parameter
+        createExprForHighKind' :: Name -> Exp -> Type -> Q (Maybe (Exp, [Pred]))
+        createExprForHighKind' name f (AppT tf ta)
+          = do res <- createExprForHighKind' name (applExpr f) ta
+               case res of Just (e,ctx) -> return $ Just (e, if isTypVar tf then AppT (ConT className) tf : ctx
+                                                                            else ctx)
+                           Nothing -> return Nothing
+        createExprForHighKind' name f (VarT v)
+          = do travV <- varToTraverseOn 
+               if v == travV then
+                 return $ Just (InfixE (Just $ VarE desc) applStarR 
+                                       (Just $ InfixE (Just (applExpr f `AppE` (VarE name))) 
+                                                       applStarL 
+                                                       (Just $ VarE asc)), [])
+                else return Nothing
+        createExprForHighKind' _ name _
+          = return Nothing
+          
+        applExpr f = (((VarE funName) `AppE` (VarE desc)) `AppE` (VarE asc)) 
+                          `AppE` f
+                          
+               
+isTypVar :: Type -> Bool
+isTypVar (VarT _) = True
+isTypVar _ = False               
+  
+getTypVarTyp :: TyVarBndr -> Type
+getTypVarTyp (PlainTV n) = VarT n
+getTypVarTyp (KindedTV n _) = VarT n
+  
+  
+thExamine :: Q [Dec] -> Q [Dec]
+thExamine decl = do d <- decl
+                    runIO (print d)
+                    return d
+
+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Boldizsar Nemeth
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Boldizsar Nemeth nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ MiniC.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeOperators, TupleSections #-}
+
+-- | Tests for the C parser
+module MiniC where
+ 
+import MiniC.ParseProgram
+import MiniC.Parser
+import MiniC.Parser.Lexical
+import MiniC.Parser.Base hiding (tuple)
+import MiniC.AST
+import MiniC.MiniCPP
+import MiniC.Semantics
+import MiniC.SymbolTable
+import MiniC.Representation
+import MiniC.Helpers
+import MiniC.Instances
+import MiniC.PrettyPrint
+import MiniC.SourceNotation
+import MiniC.TransformInfo
+import Text.Preprocess.Parser
+import SourceCode.ToSourceTree (ToSourceRose)
+import SourceCode.SourceInfo (noNodeInfo)
+import SourceCode.ASTElems
+
+import GHC.Generics
+import Text.Parsec
+import Text.Parsec.Error
+import Text.Preprocess.Rewrites
+import Debug.Trace
+import Data.SmartTrav
+import Data.Maybe
+import Data.Map(fromList)
+import Data.Function
+import Data.Either.Combinators
+import Control.Arrow
+import Control.Applicative hiding ((<|>), many)
+import Control.Lens
+import Control.Monad
+import Control.Monad.Reader
+import System.IO.Unsafe (unsafePerformIO)
+import System.Timeout
+import System.FilePath
+import System.Directory
+import Test.HUnit hiding (test)
+
+test = tests >>= runTestTT
+  
+tests = do progTests <- programTests 
+           return $ TestList 
+                      [ TestLabel "literalTests" literalTests
+                      , TestLabel "exprTests" exprTests
+                      , TestLabel "instrTests" instrTests
+                      , TestLabel "typeTests" typeTests
+                      , TestLabel "declarationTests" declarationTests
+                      , TestLabel "stmtDeclTests" stmtDeclTests
+                      , TestLabel "macroTests" macroTests
+                      , TestLabel "ifTests" ifTests
+                      , TestLabel "programTests" progTests
+                      ]
+          
+      
+-- * Literal tests
+      
+literalTests = TestList $ map (\lit -> TestLabel lit $ TestCase (assertParsedAST equallyPrinted literal lit)) literals
+
+integerLiterals = [ "1", "0", "-1", "215u", "0xFeeL", "01", "30ul", "0b011010" ]
+floatLiterals = [ "0.123", "1.4324", "1e-6", "1e-6L", "0.123f", ".1E4f", "58."
+                , "0x1.999999999999ap-4", "0x1p-1074", "0xcc.ccccccccccdp-11" ]
+charLiterals = map (\cl -> "'" ++ cl ++ "'") 
+                   [ "c", "\\n", "\\0", "\\xAA", "\\0123", "\\u00e9" ]
+stringLiterals = map (\sl -> "\"" ++ sl ++ "\"") 
+                     [ "bla", "almafa\\n", "almafa\\0", "\\xAA" ]
+                  ++ ["L\"r\\u00e9sum\\u00e9\""]
+compoundLiterals = [ "{}", "{ 1,2,3 }", "{ .x = 1, .y = 2 }"
+                   , "{ [0] = 1, [2] = 3 }"
+                   , "{ [0] = 1, 2, [2] = 3 }" ]
+
+literals = integerLiterals 
+             ++ floatLiterals 
+             ++ charLiterals 
+             ++ stringLiterals
+             ++ compoundLiterals
+
+-- * Expressions tests
+             
+-- | Tests that each expression is parsed successfully and printed back the same
+exprTests = TestList $ map (\expr -> TestLabel expr $ TestCase (assertEqualPrint expr)) expressions
+  where assertEqualPrint = assertParsedAST equallyPrinted (addVars exprVarsToAdd >> expression)
+
+exprVarsToAdd = ["a","b","c","i","n","x","f","g","scanf","printf"]
+           
+expressions = [ "&a", "*a", "*&a++"
+              , "a+b", "a = c , b"
+              , "a += *c , b"
+              , "x(1)"
+              , "x[0]"
+              , "x[0][1]"
+              , "x[0](1)"
+              , "(g)()"
+              , "(*f)(a,b)"
+              , "f(a,g)"
+              , "a>b?a:b"
+              , "a?:b"
+              , "a>b?&a:&b"
+              , "(int) 1"
+              , "(int) a"
+              , "(int) (a+1)"
+              , "sizeof(a)"
+              , "sizeof(int)"
+              , "1+sizeof(int)"
+              , "sizeof( struct { int a; } )"
+              , "scanf(\"%d\",n)"
+              , "scanf(\"%d\",&n)"
+              , "scanf(\"%d\",a+b)"
+              , "printf(\"%d\",a)"
+              , "a[i][i].x[i]" 
+              ] ++ literals
+              
+-- * Instruction tests
+     
+-- | Tests that each statement is parsed successfully and printed back the same
+instrTests 
+  = TestList $ map (\instr -> TestLabel instr $ TestCase (assertEqualPrint instr)) instructions
+  where assertEqualPrint = assertParsedAST equallyPrinted (addVars instrVarsToAdd >> statement)
+
+instrVarsToAdd = exprVarsToAdd ++ ["c","it","msg","next","sum","y"]
+        
+instructions = [ "label : a = c;"
+               , "a += 4;"
+               , "f(4); // Bazz@#&#& "
+               , "f( /* Bazz@#&#& */ 4);"
+               , "f (1);"
+               , "a += (b + 4);"
+               , "{ }"
+               , "{ a = b = 10; a += (b + 4); b = a - 1; }"
+               , "{ int a = 10; }"
+               , "{ int a = 10; a = 11; }"
+               , "{ int a = 10; a = 11; int b = 12; b += a; }"
+               , "if (a==4) b = 10; else { x = 0; y = 0; }"
+               , "if (a==4) if (b==1) c = 10;"
+               , "switch (x) { case 0 : msg = \"brumm\"; break; "
+                     ++ " case 1 : msg = \"brummbrumm\"; break; "
+                     ++ " default : break; "
+                     ++ "}"
+               , "while (x > 0) --x;"
+               , "while (next(it));"
+               , "do ++x; while (x < 100);"
+               , "for (i=0; i<n; ++i) { sum += i*i; }"
+               , "for (int i=0; i<n; ++i) { sum += i*i; }"
+               , "{ return 10; break; continue; }"
+               , "((void ( * ) (void)) 0 ) ( );"
+               , "asm (\"movb %bh (%eax)\");"
+               , "asm (\"movl %eax, %ebx\\n\\t\" \"movl $56, %esi\\n\\t\");"
+               , "asm (\"cld\\n\\t\" \"rep\\n\\t\" \"stosl\" : : \"c\" (count), \"a\" (fill_value), \"D\" (dest) : \"%ecx\", \"%edi\" );"
+               , "asm volatile (\"sidt %0\\n\" : :\"m\"(loc));"
+               , "return 0;"
+               ] ++ map (++";") expressions
+  
+-- * Type tests
+          
+typeTests = TestList $ map (\typ -> TestLabel typ $ TestCase (assertEqualPrint typ)) types
+  where assertEqualPrint = assertParsedAST equallyPrinted (addVars typesVarsToAdd >> qualifiedType)
+typesVarsToAdd = ["strlen","s1","s2","x"]     
+
+baseVarTypes = [ "void", "int", "int*"
+               , "int[5]", "int[]", "int*[10]" 
+               ]
+
+varTypes = baseVarTypes ++ map (++"*") baseVarTypes
+            ++ [ "void (*foo)(int)", "void *(*foo)(int *)", "void (*)(void)"
+               , "void (*) (int* (*) (int*,int), char (*) (char))" 
+               , "int* (*) ()" 
+               , "int* (*) (int*,int)" 
+               , "char (*) (char)" 
+               , "struct myType" 
+               , "enum myType" 
+               , "union myType" 
+               , "char str[strlen (s1) + strlen (s2) + 1]" 
+               , "typeof (int)" 
+               , "typeof (int *)" 
+               , "typeof (x[0](1))" 
+               , "typeof (*x)" 
+               ]
+
+funTypes = [ "void f()", "int main()", "int main(void)", "int f(int)", "int f(int a)", "int f(int,int)" ]
+          
+types = funTypes ++ varTypes
+               
+-- * Declaration tests
+      
+declarationTests = TestList $ map (\dd -> TestLabel dd $ TestCase (assertEqualPrint dd)) declarations
+  where assertEqualPrint = assertParsedAST equallyPrinted (addVars ddVarsToAdd >> declaration)
+ddVarsToAdd = typesVarsToAdd  
+          
+declarations = [ "int a;"
+               , "int a asm(\"r1\");"
+               , "struct addr *p;"
+               , "int[5] is;"
+               , "int a, b;"
+               , "int a, b asm(\"r1\");"
+               , "int (*arr2)[8];"
+               , "int *arr2[8];"
+               , "int a[];"
+               , "int a[8];"
+               , "int *a[8];"
+               , "int a [static 8];"
+               , "void f(int [static 8]);"
+               , "const int * a;"
+               , "int const * a;"
+               , "int const * const a;"
+               , "int restrict * volatile a;"
+               , "int const * restrict a;"
+               , "int a, b = 10, c;"
+               , "void *pt, *pt2, *pt3;"
+               , "int a = 1, b = 2, c = 3;"
+               , "int a = 1, b;"
+               , "int a, b = 2, c = 3;"
+               , "int a = 4;" 
+               , "enum myEnum;" 
+               , "enum myEnum { a, b, c };" 
+               , "enum myEnum { a, b, c, };" 
+               , "int whitespace[256] = { [' '] = 1, ['\\t'] = 1, ['\\f'] = 1, ['\\n'] = 1, ['\\r'] = 1 };"
+               , "int *(*(i));"
+               , "static void (*f)();"
+               , "void f() asm (\"myLab\");"
+               , "int main() { return 0; }"
+               , "int main(void) { return 0; }"
+               , "typedef int (*bar)(int);"
+               , "typedef struct { int i; } b;"
+               , "struct { union { int b; float c; }; int d; } foo;"
+               ] ++ map (++" a;") varTypes
+                 ++ map (++" a = 0;") varTypes
+                 ++ map (++";") funTypes
+                 ++ map (++" {}") funTypes
+               
+stmtDeclTests = TestList []
+               
+-- * Macro tests
+               
+macroTests = TestList $ map (\(tu,prep) -> TestCase (assertParsedSame eqAST (addVars vars >> whole translationUnit) tu prep)) macros
+  where vars = ["a","b","c","f","p","printf"]
+          
+macros = [ ("\n#define a int x;\n a","int x;")
+         , ("\n#define declare(typ,name) typ name;\n declare(int,x)", "int x;") 
+         , ("\n#define min(X, Y)  ((X) < (Y) ? (X) : (Y))\n"
+               ++ "int x = min(a, b), y = min(1, 2), z = min(a + 28, *p);"
+           , "int x = ((a) < (b) ? (a) : (b))," 
+               ++ "y = ((1) < (2) ? (1) : (2)),"
+               ++ "z = ((a + 28) < (*p) ? (a + 28) : (*p));"
+           )
+         , ("\n#define pair(t1,t2,name) struct name { t1 first; t2 second; };\n"
+               ++ "pair(int,bool,ib)\n" ++ "pair(int,bool,)"
+           , "struct ib { int first; bool second; };\n struct { int first; bool second; };")
+         , ("\n#define PRINT(x) printf(#x)\n int main() { PRINT(a); }"
+           ,"int main() { printf(\"a\"); }"
+           )
+         , ("\n#define x y\n int xx;", "int xx;")
+         , ("\n#define X 1\n void g() { return (X); }", "void g() { return (1); }")
+         , ("\n#define F(x) f x\n int main(){ F((1,2,3)); }", "int main(){ f(1,2,3); }")
+         , ("\n#define FAIL_IF(condition, error_code) if (condition) return (error_code)" 
+              ++ "\n int main(){ FAIL_IF(c=='(',0); }", "int main(){ if (c=='(') return (0); }")
+         ]
+         
+ifTests = TestList $ map (\(tu,prep) -> TestCase (assertParsedSame eqAST (whole translationUnit) tu prep)) ifs
+         
+ifs = [ ("\n#ifdef D\n int x; \n#endif", "")
+      , ("\n#define D\n#ifdef D\n int x; \n#endif", "int x;")
+      , ("\n#ifdef D\nint x;\n#else\nint y;\n#endif", "int y;")
+      , ("\n#define D\n#ifdef D\n int x; \n#else\n int y; \n#endif", "int x;")
+      ]
+                        
+-- * Sample program tests
+  
+programTests :: IO Test
+programTests = 
+  TestList . map (\file -> TestLabel file $ TestCase (testCase file))
+    <$> getTestsInDir "testfiles\\ok"
+  where testCase file = readFile file >>= assertParsedOkCustom 1000000 file (whole translationUnit)
+  
+getTestsInDir :: String -> IO [String]
+getTestsInDir dir = liftM ( map (combine dir) 
+                               . filter (not . (`elem` [".",".."])) 
+                          ) (getDirectoryContents dir)
+       
+useASTSource p f src 
+  = do res <- parseWithPreproc (whole p) "(test)" src
+       putStrLn $ either show f res 
+       
+showASTSource p src 
+  = do res <- parseWithPreproc (whole p) "(test)" src
+       putStrLn $ either show show res 
+       
+prettyPrintSource p src 
+  = do res <- parseWithPreproc (whole p) "(test)" src
+       putStrLn $ either show (prettyPrint . transformSourceInfo) res
+         
+prettyPrintTestFile fileName 
+  = do src <- readFile fileName
+       res <- parseWithPreproc (whole translationUnit) fileName src
+       putStrLn $ either show (prettyPrint . transformSourceInfo) res
+  
+-- * Helper functions
+
+addVars :: [String] -> CParser ()
+addVars varsToAdd 
+  = modifyState $ symbolTable.symbolMap .~ fromList entries
+  where entries = map ((unsafePerformIO.parseQualName) &&& defaultVarEntry) varsToAdd
+        defaultVarEntry name 
+          = VariableEntry [] defaultType Nothing Nothing noNodeInfo
+        defaultType = QualifiedType (Scalar ASTNothing noNodeInfo) 
+                                    (IntType Signed MiniC.AST.Int noNodeInfo) 
+                                    noNodeInfo
+                                    
+equallyPrinted :: (ToSourceRose a BI, ToSourceRose a TemplateInfo, SmartTrav a, Functor a) 
+               => String -> a BI -> Maybe String
+equallyPrinted s a = let ppres = (prettyPrint . transformSourceInfo) a
+  in if ppres == s then Nothing 
+                   else Just $ "The result of pretty printing is `" ++ ppres ++ "`"
+  
+defaultTimeoutMSecs = 100000
+
+assertParsedOk = assertParsedOkCustom defaultTimeoutMSecs "(test)"
+assertParsedAST = assertParsedASTCustom defaultTimeoutMSecs "(test)"
+
+-- | Protect tests from infinite loops
+withTimeout :: Int -> IO a -> IO a
+withTimeout msecs comp
+  = do res <- timeout msecs comp 
+       return $ fromMaybe (error $ "Did not terminate in " 
+                                      ++ show (fromIntegral msecs / 100000.0 :: Double) ++ " seconds.") res
+
+-- | Assert that parse is successful
+assertParsedOkCustom :: Int -> String -> CParser a -> String -> Assertion
+assertParsedOkCustom msecs srcname
+  = assertParsedASTCustom msecs srcname (\_ _ -> Nothing)
+         
+-- | Assert parse success and check the AST with a function that returns just an error message
+-- when the AST is not correct.
+assertParsedASTCustom :: Int -> String -> (String -> a -> Maybe String) -> CParser a -> String -> Assertion
+assertParsedASTCustom msecs srcname validate parser source 
+  = withTimeout msecs $ 
+      do res <- parseWithPreproc (whole parser) srcname source
+         assertBool ("'" ++ source ++ "' was not accepted: " ++ show (fromLeft' res)) (isRight res)
+         case validate source $ fromRight' res of 
+           Just err -> assertFailure ("'" ++ source ++ "' was not correct: " ++ err)
+           Nothing -> return ()
+        
+-- | Assert that the parse fails
+assertSyntaxError :: (Show a) => CParser a -> String -> (String -> Bool) -> Assertion 
+assertSyntaxError = assertSyntaxErrorTimeout defaultTimeoutMSecs 
+               
+assertSyntaxErrorTimeout :: (Show a) 
+  => Int -> CParser a -> String -> (String -> Bool) -> Assertion
+assertSyntaxErrorTimeout msecs parser source failMess 
+  = withTimeout msecs $
+      do res <- parseWithPreproc (whole parser) "(test)" source
+         case res of       
+           Left pErr -> case errorMessages pErr of 
+             err:_ -> assertBool ("`" ++ source ++ "` should fail with a correct message. Failed with: " ++ messageString err) 
+                        (failMess (messageString err))
+             [] -> assertFailure $ "`" ++ source ++ "` should fail with a correct message. It failed without a message"
+           Right val -> assertFailure $ "`" ++ source ++ "` should fail with a correct message. Parsed: " ++ show val
+
+-- | Assert that two ASTs are structurally equivalent
+eqAST :: (Functor a, Eq (a ())) => a b -> a b -> Bool
+eqAST = (==) `on` fmap (const ())
+  
+-- | Parses two inputs with the same parser and compares the results
+assertParsedSame :: (Eq a, Show a) => (a -> a -> Bool) -> CParser a -> String -> String -> Assertion
+assertParsedSame = assertParsedSameTimeout defaultTimeoutMSecs
+  
+assertParsedSameTimeout :: (Eq a, Show a) => Int -> (a -> a -> Bool) -> CParser a -> String -> String -> Assertion
+assertParsedSameTimeout msecs isSameAs parser s1 s2 
+  = withTimeout msecs $ 
+      do parseRes1 <- parseWithPreproc (whole parser) "(test)" s1
+         parseRes2 <- parseWithPreproc (whole parser) "(test)" s2
+         case (parseRes1,parseRes2) of
+           (Right result1, Right result2) ->  
+                    assertBool ("Parse results from `" ++ s1 ++ "` and `" ++ s2 ++ "` are not the same" )
+                                  (result1 `isSameAs` result2)
+           (Left err, _) -> assertFailure $ "Paring of `" ++ s1 ++ "` failed with error: " ++ show err
+           (_, Left err) -> assertFailure $ "Paring of `" ++ s2 ++ "` failed with error: " ++ show err
+  
+
+ MiniC/AST.hs view
@@ -0,0 +1,473 @@+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveGeneric, FlexibleContexts #-}
+
+-- | Abstract Syntax Tree of a C program.
+-- C language elements are highly recursive, so this module could only be broken up
+-- with a lot of effort and increasing complexity with type arguments.
+module MiniC.AST where
+
+import GHC.Generics
+import Data.Data
+import Data.Typeable
+
+import SourceCode.ASTElems
+
+data TranslationUnit a
+  = TranslationUnit { _tuDecls :: ASTList Declaration a
+                    , _tuInfo :: a
+                    }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+
+data Declaration a
+  = TypeDecl { _typeDecl :: TypeDefinition a }
+  | FuncDecl { _funDecl :: FunctionDeclaration a }
+  | VarDecl { _varDecl :: VariableDeclaration a }
+  | ParamDecl { _paramDecl :: ParameterDeclaration a }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+data TypeDefinition a
+  = TypeDefinition { _typeDefType :: Type a 
+                   , _typeDefInfo :: a
+                   } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+
+data FunctionDeclaration a
+  = FunctionDeclaration { _funDeclStorageSpec :: ASTList StorageSpecifier a
+                        , _funDeclQualType    :: QualifiedType a
+                        , _funDeclAsmSpec     :: ASTMaybe AsmSpecifier a
+                        , _funDeclBody        :: ASTMaybe Statement a
+                        , _funDeclInfo        :: a
+                        } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+data VariableDeclaration a
+  = VariableDeclaration { _varDeclStorageSpec :: ASTList StorageSpecifier a
+                        , _varDeclQualTyp     :: QualifiedType a 
+                        , _varDeclAsmSpec     :: ASTMaybe AsmSpecifier a
+                        , _varDeclInit        :: ASTMaybe Expression a
+                        , _varDeclDefinitions :: ASTList VariableDefinition a
+                        , _varDeclInfo        :: a
+                        } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+data VariableDefinition a 
+  = VariableDefinition { _varDefQualTyp :: TypeQualifier a
+                       , _varDefAsmSpec :: ASTMaybe AsmSpecifier a
+                       , _varDefInit    :: ASTMaybe Expression a
+                       , _varDefInfo    :: a
+                       } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)                        
+                        
+data ParameterDeclaration a
+  = ParameterDeclaration { _paramDeclQualTyp    :: QualifiedType a
+                         , _paramDeclInfo       :: a
+                         } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+data AsmSpecifier a = AsmSpecifier String a
+                      deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+-- | C storage class specifier
+data StorageSpecifier a
+  = Auto     { _storageSpecInfo :: a }    -- ^ automatic scope for variables
+  | Register { _storageSpecInfo :: a }    -- ^ suggest storing a variable on register
+  | Static   { _storageSpecInfo :: a }    -- ^ function / variable static scope
+  | Extern   { _storageSpecInfo :: a }    -- ^ function / variable external definition
+  | Inline   { _storageSpecInfo :: a }    -- ^ function inlining
+  deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+-- | C statement
+data Statement a
+  -- | A label followed by a statement
+  = Label { _stmtLabel    :: Ident a
+          , _stmtLabelled :: Statement a
+          , _stmtInfo     :: a
+          }
+  -- | A statement of the form @case expr : stmt@
+  | Case { _stmtCaseExpr :: Expression a
+         , _stmtCaseBody :: Statement a
+         , _stmtInfo :: a
+         }
+  -- | A statement of the form @case fromExpr .. toExpr : stmt@
+  | CaseInterval { _stmtCaseRng :: ASTPair Expression Expression a
+                 , _stmtCaseBody :: Statement a
+                 , _stmtCaseInfo :: a
+                 }
+  -- | The default case @default : stmt@
+  | Default { _stmtCaseBody :: Statement a
+            , _stmtInfo :: a
+            }
+  -- | A simple statement, that is in C: evaluating an expression with
+  --   side-effects and discarding the result.
+  | Expr { _stmtExpr :: Expression a
+         , _stmtInfo :: a 
+         }
+  -- | compound statement @{ statements }@
+  | Compound { _compoundStmts :: ASTList (ASTEither Declaration Statement) a
+             , _stmtInfo :: a 
+             }
+  -- | conditional statement @CIf ifExpr thenStmt maybeElseStmt at@
+  | If { _stmtPred :: Expression a
+       , _stmtThen :: Statement a
+       , _stmtElse :: ASTMaybe Statement a
+       , _stmtInfo :: a
+       }
+  -- | switch statement @CSwitch selectorExpr switchStmt@, where
+  -- @switchStmt@ usually includes /case/, /break/ and /default/
+  -- statements
+  | Switch { _stmtSwitchExpr :: Expression a
+           , _stmtSwitchBody :: Statement a
+           , _stmtInfo :: a
+           }
+  -- | while-do loop
+  | While { _stmtPred :: Expression a
+          , _stmtLoopBody :: Statement a
+          , _stmtInfo :: a
+          }          
+  -- | do-while loop
+  | DoWhile { _stmtLoopBody :: Statement a
+            , _stmtPred :: Expression a
+            , _stmtInfo :: a
+            }            
+  | For { _stmtForInit :: ASTMaybe (ASTEither Expression Declaration) a
+        , _stmtForTest :: ASTMaybe Expression a
+        , _stmtForIncrement :: ASTMaybe Expression a
+        , _stmtLoopBody :: Statement a
+        , _stmtInfo :: a
+        }
+  | Goto { _stmtGotoExpr :: Expression a
+         , _stmtInfo :: a
+         }
+  | Continue { _stmtInfo :: a }
+  | Break { _stmtInfo :: a }
+  | Return { _stmtReturnValue :: ASTMaybe Expression a
+           , _stmtInfo :: a
+           }
+  -- | a simple semicolon
+  | EmptyStmt { _stmtInfo :: a }
+  | AsmStmt { _stmtInlineAsm :: InlineAssembly a
+            , _stmtInfo :: a
+            }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+-- | Inline assembly fragment
+data InlineAssembly a
+ = InlineAssembly { _inlAsmVolatile :: Bool
+                  , _inlAsmCode     :: ASTList AssemblyString a
+                  , _inlAsmOutput   :: ASTMaybe (ASTList AssemblyParam) a -- ^ If colon exists: Just [], if not: Nothing  
+                  , _inlAsmInput    :: ASTMaybe (ASTList AssemblyParam) a -- ^ If colon exists: Just [], if not: Nothing 
+                  , _inlAsmTemp     :: ASTMaybe (ASTList AssemblyParam) a -- ^ If colon exists: Just [], if not: Nothing 
+                  , _inlAsmInfo     :: a
+                  } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+                  
+data AssemblyString a 
+  = AssemblyString { _asmCodeStr  :: String 
+                   , _asmCodeInfo :: a
+                   } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+  
+data AssemblyParam a
+  = AssemblyParam { _asmParMarker :: String
+                  , _asmParIdent  :: ASTMaybe Ident a
+                  , _asmParInfo   :: a
+                  } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+                  
+data AsmParamMarker a
+  = AsmParamMarker { _asmParMarkStr  :: String 
+                   , _asmParMarkInfo :: a
+                   } deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+-- * Expressions
+ 
+data Expression a
+  = -- | cond ? then_expr : else_expr
+    Cond        { _exprCond          :: Expression a
+                , _exprTrue          :: ASTMaybe Expression a -- ^ true-expression, can be omitted in GNU-C
+                , _exprFalse         :: Expression a
+                , _exprInfo          :: a
+                }
+  | Binary      { _exprBinOperator   :: BinaryOp a
+                , _exprLeftSide      :: Expression a
+                , _exprRightSide     :: Expression a
+                , _exprInfo          :: a
+                }
+  | Cast        { _exprCastTyp       :: QualifiedType a
+                , _exprCasted        :: Expression a
+                , _exprInfo          :: a
+                }
+  | Unary       { _exprUnaryOp       :: UnaryOp a
+                , _exprOperand       :: Expression a
+                , _exprInfo          :: a
+                }
+  | SizeOfExpr  { _exprSizeOfExpr    :: Expression a
+                , _exprInfo          :: a
+                }
+  | SizeOfType  { _exprSizeOfType    :: QualifiedType a
+                , _exprInfo          :: a
+                }
+  | Call        { _exprCallFun       :: Expression a
+                , _exprCallArgs      :: ASTParenList Expression a
+                , _exprInfo          :: a
+                }
+  | -- | Both . and -> member operators
+    Member      { _exprBase          :: Expression a
+                , _exprMemberDeref   :: MemberDeref a
+                , _exprMember        :: Ident a
+                , _exprInfo          :: a
+                }
+  | -- | arr[ind] expressions
+    Indexing    { _exprBase          :: Expression a
+                , _exprIndex         :: ArrayIndex a
+                , _exprInfo          :: a
+                }
+  -- | Identifier (including enumeration variants)
+  | NameExpr    { _exprIdent         :: Ident a 
+                , _exprInfo          :: a
+                }             
+  -- | Integer, character, floating point and string constants
+  | LitExpr     { _exprLiteral       :: Literal a 
+                , _exprInfo          :: a
+                }                         
+  | ParenExpr   { _parenExpr         :: Expression a
+                , _exprInfo          :: a
+                }                
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+data MemberDeref a 
+  = SimpleMember { _derefInfo :: a } -- ^ The "." operator
+  | DerefMember { _derefInfo :: a }  -- ^ The "->" operator
+  deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data) 
+  
+data ArrayIndex a 
+  = ArrayIndex { _indexExpr :: Expression a
+               , _indexInfo :: a
+               }
+  deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+-- | C binary operators (K&R A7.6-15)
+--
+data BinaryOp a 
+  = MulOp           { _binOpInfo :: a }   -- ^ * operator
+  | DivOp           { _binOpInfo :: a }   -- ^ / operator
+  | RemainderOp     { _binOpInfo :: a }   -- ^ % operator, remainder of division
+  | AddOp           { _binOpInfo :: a }   -- ^ + operator
+  | SubOp           { _binOpInfo :: a }   -- ^ - operator
+  | ShiftLeftOp     { _binOpInfo :: a }   -- ^ << operator
+  | ShiftRightOp    { _binOpInfo :: a }   -- ^ >> operator
+  | LessOp          { _binOpInfo :: a }   -- ^ < operator
+  | GreaterOp       { _binOpInfo :: a }   -- ^ > operator
+  | LessOrEqOp      { _binOpInfo :: a }   -- ^ <= operator
+  | GreaterOrEqOp   { _binOpInfo :: a }   -- ^ >= operator
+  | EqOp            { _binOpInfo :: a }   -- ^ == operator
+  | NotEqOp         { _binOpInfo :: a }   -- ^ != operator
+  | BitAndOp        { _binOpInfo :: a }   -- ^ & operator, bitwise and
+  | BitXorOp        { _binOpInfo :: a }   -- ^ ^ operator, exclusive bitwise or
+  | BitOrOp         { _binOpInfo :: a }   -- ^ | operator, inclusive bitwise or
+  | LogicAndOp      { _binOpInfo :: a }   -- ^ && operator, logical and
+  | LogicOrOp       { _binOpInfo :: a }   -- ^ || operator, logical or
+  | CommaOp         { _binOpInfo :: a }   -- ^ , operator, discards the result of the first expression
+  | AssignOp        { _binOpInfo :: a }   -- ^ = operator, assignment
+  | MulAssOp        { _binOpInfo :: a }   -- ^ *= operator, inplace multiplication
+  | DivAssOp        { _binOpInfo :: a }   -- ^ /= operator, inplace division
+  | RemainderAssOp  { _binOpInfo :: a }   -- ^ %= operator, inplace remainder
+  | AddAssOp        { _binOpInfo :: a }   -- ^ += operator, inplace addition
+  | SubAssOp        { _binOpInfo :: a }   -- ^ -= operator, inplace substraction
+  | ShiftLeftAssOp  { _binOpInfo :: a }   -- ^ <<= operator, inplace left shift
+  | ShiftRightAssOp { _binOpInfo :: a }   -- ^ >>= operator, inplace right shift
+  | BitAndAssOp     { _binOpInfo :: a }   -- ^ &= operator, inplace bitwise and
+  | BitXorAssOp     { _binOpInfo :: a }   -- ^ ^= operator, inplace bitwise exclusive or
+  | BitOrAssOp      { _binOpInfo :: a }   -- ^ |= operator, inplace bitwise or
+  deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+ 
+-- | C unary operator (K&R A7.3-4)
+--
+data UnaryOp a 
+  = PreIncOp      { _unaryOpInfo :: a }   -- ^ ++ operator, prefix increment operator
+  | PreDecOp      { _unaryOpInfo :: a }   -- ^ -- operator, prefix decrement operator
+  | PostIncOp     { _unaryOpInfo :: a }   -- ^ ++ operator, postfix increment operator
+  | PostDecOp     { _unaryOpInfo :: a }   -- ^ -- operator, postfix decrement operator
+  | AddressOp     { _unaryOpInfo :: a }   -- ^ & operator, address operator
+  | DereferenceOp { _unaryOpInfo :: a }   -- ^ * operator, dereferencing operator
+  | PrePlusOp     { _unaryOpInfo :: a }   -- ^ + operator, prefix plus (no function)
+  | PreMinOp      { _unaryOpInfo :: a }   -- ^ - operator, prefix minus (negation)
+  | ComplementOp  { _unaryOpInfo :: a }   -- ^ ~ operator, one's complement
+  | LogicNegOp    { _unaryOpInfo :: a }   -- ^ ! operator, logical negation
+  deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+
+data Literal a
+  = IntLit   { _litInt         :: Integer
+             , _litIntSpec     :: IntLitSpec
+             , _litInfo        :: a
+             }
+  | CharLit  { _unicodeLit     :: Bool
+             , _litChar        :: Char 
+             , _litInfo        :: a
+             }
+  | FloatLit { _litFloat       :: Rational
+             , _litFloatSize   :: Maybe FloatLitSize
+             , _litInfo        :: a
+             }
+  | StrLitList { _strLits :: ASTList StringLiteral a }
+  | CompoundLit { _litCompund  :: ASTList CompoundLitElem a
+                , _litInfo :: a 
+                }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+data StringLiteral a
+  = StringLiteral { _strLitUnicode  :: Bool
+                  , _litText        :: String 
+                  , _strLitInfo     :: a
+                  } 
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+data CompoundLitElem a 
+  = CompoundLitElem { _compLitDesigns :: ASTList Designator a
+                    , _compLitValue   :: Expression a
+                    , _compLitInfo    :: a
+                    }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+-- | Compound literal designated identifier
+data Designator a 
+  = MemberDesignator { _designatorMember :: Ident a
+                     , _designatorInfo :: a
+                     }
+  | ArrDesignator    { _designatorIndex :: Expression a
+                     , _designatorInfo :: a
+                     }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+-- | Identifier
+data Ident a = Ident { _identStr :: String
+                     , _identInfo :: a 
+                     }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+-- * Types
+    
+data QualifiedType a 
+  = QualifiedType { _qualTypQual :: TypeQualifier a
+                  , _qualTypTyp  :: Type a
+                  , _qualTypInfo :: a
+                  } 
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+data Type a
+  = VoidType     { _voidTypInfo :: a }
+  | IntType      { _intTypSign :: Sign
+                 , _intTypSize :: IntSize
+                 , _typInfo :: a
+                 }
+  | FloatingType { _floatTypSize :: FloatingSize
+                 , _floatTypInfo :: a
+                 }
+  | BoolType     { _typInfo :: a }
+  | StructType   { _structTypFields :: StructUnion a
+                 , _typInfo :: a
+                 }
+  | UnionType    { _unionTypFields :: StructUnion a
+                 , _typInfo :: a
+                 }
+  | EnumType     { _enumTypVariants :: Enumeration a
+                 , _typInfo :: a
+                 }
+  | TypeDef      { _typDefTyp :: QualifiedType a
+                 , _typDefIdent :: ASTMaybe Ident a
+                 , _typInfo :: a
+                 }
+  | FunType      { _funTypRet :: QualifiedType a
+                 , _funTypParams :: ASTParenList ParameterDeclaration a
+                 , _typInfo :: a
+                 }
+  | TypeName     { _typNameId :: Ident a }
+  | TypeOfType   { _typOfTyp :: QualifiedType a
+                 , _typInfo :: a
+                 }
+  | TypeOfExpr   { _typOfExpr :: Expression a
+                 , _typInfo :: a
+                 }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+data TypeQualifier a
+  = Scalar       { _qualIdent :: ASTMaybe Ident a
+                 , _qualInfo :: a
+                 }
+  | PtrQual      { _qualBase :: TypeQualifier a
+                 , _qualInfo :: a
+                 }
+  | ConstQual    { _qualBase :: TypeQualifier a
+                 , _qualInfo :: a
+                 }
+  | VolatileQual { _qualBase :: TypeQualifier a
+                 , _qualInfo :: a
+                 }
+  | ArrayQual    { _arrTypQual  :: ArrayTypeQual a
+                 , _qualBase :: TypeQualifier a
+                 , _qualInfo :: a
+                 }
+  | RestrictQual { _qualBase :: TypeQualifier a
+                 , _qualInfo :: a
+                 }
+  | ParenQual    { _qualBase :: TypeQualifier a
+                 , _qualInfo :: a
+                 }
+  | StaticQual   { _qualInfo :: a }
+   deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+data ArrayTypeQual a 
+  = ArrayTypeQual { _arrElemQual     :: ASTMaybe TypeQualifier a
+                  , _arrQualSize     :: ASTMaybe Expression a
+                  , _arrTypQualInfo  :: a
+                  }
+  deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+    
+-- | C structure or union specifiers
+--  Either @identifier@ or the declaration list @struct-decls@ (or both)
+--  have to be present.
+
+data StructUnion a
+  = StructUnion { _structUnionId :: ASTMaybe Ident a           -- ^ identifier (Nothing if anonymous)
+                , _structUnionFields :: ASTMaybe (ASTList Declaration) a -- ^ member declarations (Nothing if just declared not defined)
+                , _structUnionInfo :: a
+                }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+   
+-- | C enumeration specifier
+--
+--  * Either the identifier or the enumerator-list (or both) have to be present.
+--
+data Enumeration a
+  = Enumeration { _enumName :: ASTMaybe Ident a   -- ^ identifier (Nothing if anonymous)
+                , _enumVariants :: ASTMaybe (ASTList Variant) a -- ^ variant declarations
+                , _enumInfo :: a
+                } 
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+-- | The enumerator list is of the form @(enumeration-constant, enumeration-value?)@, where the latter
+--   is an optional constant integral expression.
+--
+data Variant a 
+  = Variant { _variantName :: Ident a               -- ^ variant name 
+            , _variantValue :: ASTMaybe Expression a  -- ^ explicit variant value
+            , _variantInfo :: a
+            }
+    deriving (Show, Eq, Ord, Functor, Generic, Typeable, Data)
+
+-- * Types to store AST data
+
+data IntLitSpec 
+  = IntLitSpec { _intLitSize :: Maybe IntLitSize
+               , _intLitSign :: Maybe IntLitSign
+               } 
+    deriving (Show, Eq, Ord, Generic, Typeable, Data)
+                             
+data IntLitSize = LitLong | LitLongLong 
+    deriving (Show, Eq, Ord, Generic, Typeable, Data)
+    
+data IntLitSign = LitUnsigned  
+    deriving (Show, Eq, Ord, Generic, Typeable, Data)
+    
+data FloatLitSize = LitFloat | LitLongDouble
+    deriving (Show, Eq, Ord, Generic, Typeable, Data) 
+    
+data FloatingSize = Float | Double | LongDouble
+    deriving (Show, Eq, Ord, Generic, Typeable, Data)
+
+data IntSize = Char | Short | Int | LongInt | LongLongInt
+    deriving (Show, Eq, Ord, Generic, Typeable, Data)
+
+data Sign = Signed | Unsigned
+    deriving (Show, Eq, Ord, Generic, Typeable, Data)
+
+ MiniC/GenTemplate.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RebindableSyntax #-}
+
+-- | A module to generate nodes with default source templates
+module MiniC.GenTemplate where
+
+import MiniC.AST
+import MiniC.Instances
+import MiniC.Representation
+import MiniC.SourceNotation
+import SourceCode.SourceTree
+import SourceCode.ASTElems
+import MiniC.Semantics
+import Data.Maybe
+import Control.Lens
+import Debug.Trace
+
+import qualified Prelude
+import Prelude hiding (fromInteger)
+
+-- A little hack to disable polymorphism of numeric literals
+fromInteger :: Integer -> Int
+fromInteger = Prelude.fromInteger
+
+genInfo :: SourceTemplate -> NI
+genInfo st = NodeInfo (TemplateInfo Nothing (Just st)) emptySemaInfo
+
+infixr 6 +>
+
+(+>) :: ToTemplateElem a => a -> SourceTemplate -> SourceTemplate
+a +> st = toTemplateElem a : st
+
+infixl 9 //
+
+class ToNodeDir nd where
+  (//) :: NodeIndex -> nd -> NodeIndex
+  
+instance ToNodeDir Int where
+  ni // i = NthChildOf i ni
+  
+data Up = Up
+
+instance ToNodeDir Up where
+  ni // Up = ParentOf ni
+  
+class ToTemplateElem a where
+  toTemplateElem :: a -> SourceTemplateElem
+
+instance ToTemplateElem String where
+  toTemplateElem = TextElem
+  
+instance ToTemplateElem NodeIndex where
+  toTemplateElem = NodeElem
+  
+  
+genScalarQual :: String -> TypeQualifierNI
+genScalarQual s = Scalar (ASTJust (Ident s (genInfo (s +> [])))) (genInfo ( Current//0 +> [] ))
+  
+-- | Adds a pointer to the qualifier, looks for cases when have to put the qualifier in parentheses.
+addPtrToQual :: Maybe TypeQualifierNI -> TypeQualifierNI -> TypeQualifierNI
+addPtrToQual outer
+  = wrap . genPtrQual
+  where wrap = case outer of Just (ArrayQual {}) -> genParenQual
+                             _                   -> id
+        
+removePtrFromQual :: Maybe TypeQualifierNI -> TypeQualifierNI -> TypeQualifierNI
+removePtrFromQual _ ptrq@(PtrQual{}) = ptrq ^?! qualBase
+removePtrFromQual _ tq = tq
+        
+genParenQual :: TypeQualifierNI -> TypeQualifierNI
+genParenQual tq = ParenQual tq (genInfo ( "(" +> Current//0 +> ")" +> [] ))
+        
+genPtrQual :: TypeQualifierNI -> TypeQualifierNI
+genPtrQual tq = PtrQual tq (genInfo ( "*" +> Current//0 +> [] ))
+        
+genArrayQual :: TypeQualifierNI -> TypeQualifierNI
+genArrayQual elem
+  = wrap $ ArrayQual (ArrayTypeQual ASTNothing ASTNothing (genInfo ( "[]" +> [] ))) elem
+                     (genInfo ( Current//1 +> Current//0 +> [] ))
+  where wrap = case elem of PtrQual {} -> \q -> ParenQual q (genInfo ( "(" +> Current//0 +> ")" +> [] ))
+                            _          -> id 
+    
+genDerefExpr :: ExpressionNI -> ExpressionNI
+genDerefExpr e 
+  = let op = DereferenceOp (genInfo ( "*" +> [] ))
+        unexpr = Unary op e (genInfo ( Current//0 +> Current//1 +> [] ))
+     in ParenExpr unexpr (genInfo ( "(" +> Current//0 +> ")" +> [] ))
+      
+genMemberDeref :: MemberDerefNI
+genMemberDeref = DerefMember (genInfo ( "->" +> [] ))    
+  
+genMemberSimple :: MemberDerefNI
+genMemberSimple = SimpleMember (genInfo ( "." +> [] ))
+                      
+astFilter :: (e NI -> Maybe (f NI)) -> ASTList e NI -> ASTList f NI
+astFilter pred (ASTCons listHead listTail listInfo) 
+  = case pred listHead of Just x  -> ASTCons x (astFilter pred listTail) listInfo
+                          Nothing -> astFilter pred listTail
+astFilter pred ASTNil = ASTNil
+
+
+
+ MiniC/Helpers.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, RankNTypes
+           , UndecidableInstances, ScopedTypeVariables, StandaloneDeriving #-}
+
+-- | Helper functions for parsing and low-level analyse of C code.
+module MiniC.Helpers where
+
+import MiniC.Representation
+import MiniC.AST
+import MiniC.Instances
+import MiniC.Semantics
+import MiniC.PrettyPrint 
+import Data.Data
+import Data.Maybe
+import Control.Lens
+import Control.Applicative
+import Control.Monad.State
+import Data.Data.Lens
+import SourceCode.ASTElems
+import SourceCode.SourceInfo
+import Debug.Trace
+
+-- * AST utility functions
+
+-- | A class to retrieve identifiers of AST nodes. This is semi-boilerplate code.
+-- There are some recurring patterns but there are a lot of exceptions.
+-- Declared Id in 'SemaInfo' is generated from this.
+class (Typeable ni, Data (a ni)) => Id a ni where
+  -- Gives a traversal, that captures the only one identifier if found.
+  ident :: a ni -> Traversal' (a ni) (Ident ni)
+
+  -- | Getter for the identifier
+  getId :: a ni -> Maybe (Ident ni)
+  getId x = x ^? ident x
+  
+  -- | Setter for the identifier
+  setId :: Ident ni -> a ni -> a ni
+  setId id x = x & ident x .~ id
+
+instance (Typeable a, Data (Type a), Data a) => Id Declaration a where
+  ident d@(TypeDecl {}) = typeDecl . ident (d ^?! typeDecl)
+  ident d@(FuncDecl {}) = funDecl . ident (d ^?! funDecl)
+  ident d@(VarDecl {}) = varDecl . ident (d ^?! varDecl)
+  ident d@(ParamDecl {}) = varDecl . ident (d ^?! varDecl)
+
+instance (Typeable a, Data (Type a), Data a) => Id TypeDefinition a where
+  ident d = typeDefType . ident (d ^. typeDefType)
+
+instance (Typeable a, Data (Type a), Data a) => Id FunctionDeclaration a where
+  ident d = funDeclQualType . ident (d ^. funDeclQualType)
+
+instance (Typeable a, Data (Type a), Data a) => Id VariableDeclaration a where
+  ident d = varDeclQualTyp . ident (d ^. varDeclQualTyp)
+
+instance (Typeable a, Data (Type a), Data a) => Id VariableDefinition a where
+  ident d = varDefQualTyp . ident (d ^. varDefQualTyp)
+
+instance (Typeable a, Data (Type a), Data a) => Id ParameterDeclaration a where
+  ident d = paramDeclQualTyp . ident (d ^. paramDeclQualTyp)
+  
+instance (Typeable a, Data (Type a), Data a) => Id TypeQualifier a where
+  ident (Scalar {}) = qualIdent.astMaybe.traverse
+  ident d = qualBase . ident (d ^?! qualBase)
+
+instance (Typeable a, Data (Type a), Data a) => Id QualifiedType a where
+  ident d = qualTypQual . ident (d ^. qualTypQual)
+
+instance (Typeable a, Data (Type a), Data a) => Id Type a where
+  ident d@(StructType {}) = structTypFields . ident (d ^?! structTypFields)
+  ident d@(UnionType {}) = unionTypFields . ident (d ^?! unionTypFields)
+  ident d@(EnumType {}) = enumTypVariants . ident (d ^?! enumTypVariants)
+  ident d@(TypeDef {_typDefIdent = ASTJust _}) = typDefIdent.astMaybe.traverse
+  ident d@(TypeDef {}) = typDefTyp . ident (d ^?! typDefTyp)
+  ident d@(TypeName {}) = typNameId
+
+instance (Typeable a, Data (Type a), Data a) => Id StructUnion a where
+  ident _ = structUnionId.astMaybe.traverse
+
+instance (Typeable a, Data (Type a), Data a) => Id Enumeration a where
+  ident _ = enumName.astMaybe.traverse
+  
+instance (Typeable a, Data (ASTTriple n m p a), Data a, Id n a) => Id (ASTTriple n m p) a where
+  ident d = ast_triple_1 . ident (d ^. ast_triple_1)
+
+-- TODO: review the validity of use of qualifier application
+  
+-- | Applies a type qualifier on a qualified type. 
+-- For example: Applying @*@ to @int a@ gives @int *a@. 
+--              Applying @*a[10]@ to @int *a@ gives @int *(*a)[10]@.
+applyQualTo :: forall ni . (SourceInfo ni) => TypeQualifier ni -> QualifiedType ni -> ni -> QualifiedType ni
+applyQualTo tq (QualifiedType tq2 t _) = QualifiedType (tq2 `qualOn` tq) t
+  where qualOn :: TypeQualifier ni -> TypeQualifier ni -> TypeQualifier ni
+        (Scalar ASTNothing _) `qualOn` tq = tq
+        (PtrQual tq' ni') `qualOn` tq 
+          = PtrQual (tq' `qualOn` tq) noNodeInfo
+        (ConstQual tq' ni') `qualOn` tq 
+          = ConstQual (tq' `qualOn` tq) noNodeInfo
+        (VolatileQual tq' ni') `qualOn` tq 
+          = VolatileQual (tq' `qualOn` tq) noNodeInfo
+        (ArrayQual arr tq' ni') `qualOn` tq 
+          = ArrayQual arr (tq' `qualOn` tq) noNodeInfo
+        (RestrictQual tq' ni') `qualOn` tq 
+          = RestrictQual (tq' `qualOn` tq) noNodeInfo
+          
+data QualMatch ni = QualMatch { qmMatched :: TypeQualifier ni
+                              , qmCtx :: Maybe (TypeQualifier ni) }
+     
+    
+matchQualParent :: Eq ni => TypeQualifier ni -> Simple Traversal (TypeQualifier ni) (TypeQualifier ni)
+matchQualParent pattern f t 
+  | Just childQual <- t ^? qualBase 
+  , childQual `similarQual` pattern 
+  = f t
+matchQualParent pattern f t
+  = (qualBase . matchQualParent pattern) f t
+
+matchQual :: Eq ni => TypeQualifier ni -> Simple Traversal (TypeQualifier ni) (TypeQualifier ni)
+matchQual pattern f t 
+  | t `similarQual` pattern 
+  = f t
+matchQual pattern f t
+  = (qualBase . matchQual pattern) f t
+
+filterTrav :: (b -> Bool) -> Simple Traversal a b -> Simple Traversal a a
+filterTrav pred q f t = case pred <$> (t ^? q) of Just True -> f t 
+                                                  _         -> pure t
+
+-- | Applies a function to a specified position of the type qualifier.
+{-
+modifyQual 
+  :: (Typeable ni, Data ni, Eq ni) 
+  => (Maybe (TypeQualifier ni) -> TypeQualifier ni -> TypeQualifier ni) 
+       -- ^ additional qualification, based on a context (previous qualification)
+      -> TypeQualifier ni -- ^ positioning qualification, addition happens when this matches the rest
+      -> TypeQualifier ni -- ^ type qualification to change
+      -> (TypeQualifier ni, Maybe ())
+modifyQual tf q0 q = modifyQual' Nothing tf q0 q
+  where modifyQual' ctx tf q0 q 
+          | q0 `similarQual` q
+          = modify (\st -> st { qmInner = q }) >> return (tf ctx q)
+        modifyQual' _ tf q0 q 
+          = q & qualBase <%= modifyQual' (Just q) tf q0
+-}
+      
+-- | The user don't have to input the exact qualified name, but a simplified version
+similarQual :: Eq ni => TypeQualifier ni -> TypeQualifier ni -> Bool
+-- similar qual ignores array indexes and element type specifiers
+(ArrayQual _ qb1 _) `similarQual` (ArrayQual _ qb2 _) 
+  = qb1 `similarQual` qb2
+tq1 `similarQual` tq2 
+  = tq1 == tq2
+      
+    
+instance Show QualifiedName where
+  show (QualifiedName ns sc name) = show ns ++ show sc ++ "::" ++ prettyPrint name
+  
+deriving instance Show SemaInfo
+
+ MiniC/Instances.hs view
@@ -0,0 +1,316 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
+-- | Derived and generated instances for AST elements.
+module MiniC.Instances where
+
+import MiniC.AST
+import MiniC.Representation
+import MiniC.Semantics
+import SourceCode.ASTNode
+import SourceCode.ASTElems
+import SourceCode.ToSourceTree
+import SourceCode.SourceInfo
+import Control.Lens
+import Control.Applicative
+import GHC.Generics
+import Data.SmartTrav
+import Data.Data.Lens (uniplate)
+import Data.Data
+
+-- * Derived type classes for AST elements
+     
+type TranslationUnitBI = TranslationUnit BI+type TranslationUnitNI = TranslationUnit NI
+instance (SourceInfo a, Show a) => ToSourceRose TranslationUnit a
+instance ASTNode TranslationUnit a
+instance Data a => Plated (TranslationUnit a) where plate = uniplate
+makeLenses ''TranslationUnit
+deriveSmartTrav ''TranslationUnit
+
+type DeclarationBI = Declaration BI+type DeclarationNI = Declaration NI
+instance (SourceInfo a, Show a) => ToSourceRose Declaration a
+instance ASTNode Declaration a+instance Data a => Plated (Declaration a) where plate = uniplate
+makeLenses ''Declaration+deriveSmartTrav ''Declaration
+
+type StorageSpecifierBI = StorageSpecifier BI+type StorageSpecifierNI = StorageSpecifier NI
+instance (SourceInfo a, Show a) => ToSourceRose StorageSpecifier a
+instance ASTNode StorageSpecifier a+instance Data a => Plated (StorageSpecifier a) where plate = uniplate
+makeLenses ''StorageSpecifier+deriveSmartTrav ''StorageSpecifier
+
+type TypeDefinitionBI = TypeDefinition BI+type TypeDefinitionNI = TypeDefinition NI
+instance (SourceInfo a, Show a) => ToSourceRose TypeDefinition a
+instance ASTNode TypeDefinition a+instance Data a => Plated (TypeDefinition a) where plate = uniplate
+makeLenses ''TypeDefinition+deriveSmartTrav ''TypeDefinition
+
+type FunctionDeclarationBI = FunctionDeclaration BI+type FunctionDeclarationNI = FunctionDeclaration NI
+instance (SourceInfo a, Show a) => ToSourceRose FunctionDeclaration a
+instance ASTNode FunctionDeclaration a+instance Data a => Plated (FunctionDeclaration a) where plate = uniplate
+makeLenses ''FunctionDeclaration+deriveSmartTrav ''FunctionDeclaration
+
+type VariableDeclarationBI = VariableDeclaration BI+type VariableDeclarationNI = VariableDeclaration NI
+instance (SourceInfo a, Show a) => ToSourceRose VariableDeclaration a
+instance ASTNode VariableDeclaration a+instance Data a => Plated (VariableDeclaration a) where plate = uniplate
+makeLenses ''VariableDeclaration+deriveSmartTrav ''VariableDeclaration
+
+type ParameterDeclarationBI = ParameterDeclaration BI+type ParameterDeclarationNI = ParameterDeclaration NI
+instance (SourceInfo a, Show a) => ToSourceRose ParameterDeclaration a
+instance ASTNode ParameterDeclaration a+instance Data a => Plated (ParameterDeclaration a) where plate = uniplate
+makeLenses ''ParameterDeclaration+deriveSmartTrav ''ParameterDeclaration
+
+type VariableDefinitionBI = VariableDefinition BI+type VariableDefinitionNI = VariableDefinition NI
+instance (SourceInfo a, Show a) => ToSourceRose VariableDefinition a
+instance ASTNode VariableDefinition a+instance Data a => Plated (VariableDefinition a) where plate = uniplate
+makeLenses ''VariableDefinition+deriveSmartTrav ''VariableDefinition
+
+type InlineAssemblyBI = InlineAssembly BI+type InlineAssemblyNI = InlineAssembly NI
+instance (SourceInfo a, Show a) => ToSourceRose InlineAssembly a
+instance ASTNode InlineAssembly a+instance Data a => Plated (InlineAssembly a) where plate = uniplate
+makeLenses ''InlineAssembly+deriveSmartTrav ''InlineAssembly
+
+type AssemblyStringBI = AssemblyString BI+type AssemblyStringNI = AssemblyString NI
+instance (SourceInfo a, Show a) => ToSourceRose AssemblyString a
+instance ASTNode AssemblyString a+instance Data a => Plated (AssemblyString a) where plate = uniplate
+makeLenses ''AssemblyString+deriveSmartTrav ''AssemblyString
+
+type AsmSpecifierBI = AsmSpecifier BI+type AsmSpecifierNI = AsmSpecifier NI
+instance (SourceInfo a, Show a) => ToSourceRose AsmSpecifier a
+instance ASTNode AsmSpecifier a+instance Data a => Plated (AsmSpecifier a) where plate = uniplate
+makeLenses ''AsmSpecifier+deriveSmartTrav ''AsmSpecifier
+
+type StatementBI = Statement BI+type StatementNI = Statement NI
+instance (SourceInfo a, Show a) => ToSourceRose Statement a
+instance ASTNode Statement a+instance Data a => Plated (Statement a) where plate = uniplate
+makeLenses ''Statement+deriveSmartTrav ''Statement
+
+type AssemblyParamBI = AssemblyParam BI+type AssemblyParamNI = AssemblyParam NI
+instance (SourceInfo a, Show a) => ToSourceRose AssemblyParam a
+instance ASTNode AssemblyParam a+instance Data a => Plated (AssemblyParam a) where plate = uniplate
+makeLenses ''AssemblyParam+deriveSmartTrav ''AssemblyParam
+
+type ExpressionBI = Expression BI+type ExpressionNI = Expression NI
+instance (SourceInfo a, Show a) => ToSourceRose Expression a
+instance ASTNode Expression a+instance Data a => Plated (Expression a) where plate = uniplate
+makeLenses ''Expression+deriveSmartTrav ''Expression
+
+type BinaryOpBI = BinaryOp BI+type BinaryOpNI = BinaryOp NI
+instance (SourceInfo a, Show a) => ToSourceRose BinaryOp a
+instance ASTNode BinaryOp a+instance Data a => Plated (BinaryOp a) where plate = uniplate
+makeLenses ''BinaryOp+deriveSmartTrav ''BinaryOp
+
+type UnaryOpBI = UnaryOp BI+type UnaryOpNI = UnaryOp NI
+instance (SourceInfo a, Show a) => ToSourceRose UnaryOp a
+instance ASTNode UnaryOp a+instance Data a => Plated (UnaryOp a) where plate = uniplate
+makeLenses ''UnaryOp+deriveSmartTrav ''UnaryOp
+
+type ArrayIndexBI = ArrayIndex BI+type ArrayIndexNI = ArrayIndex NI
+instance (SourceInfo a, Show a) => ToSourceRose ArrayIndex a
+instance ASTNode ArrayIndex a+instance Data a => Plated (ArrayIndex a) where plate = uniplate
+makeLenses ''ArrayIndex+deriveSmartTrav ''ArrayIndex
+
+type MemberDerefBI = MemberDeref BI+type MemberDerefNI = MemberDeref NI
+instance (SourceInfo a, Show a) => ToSourceRose MemberDeref a
+instance ASTNode MemberDeref a+instance Data a => Plated (MemberDeref a) where plate = uniplate
+makeLenses ''MemberDeref+deriveSmartTrav ''MemberDeref
+
+type LiteralBI = Literal BI+type LiteralNI = Literal NI
+instance (SourceInfo a, Show a) => ToSourceRose Literal a
+instance ASTNode Literal a+instance Data a => Plated (Literal a) where plate = uniplate
+makeLenses ''Literal+deriveSmartTrav ''Literal
+
+type IdentBI = Ident BI+type IdentNI = Ident NI
+instance (SourceInfo a, Show a) => ToSourceRose Ident a
+instance ASTNode Ident a+instance Data a => Plated (Ident a) where plate = uniplate
+makeLenses ''Ident+deriveSmartTrav ''Ident
+
+type QualifiedTypeBI = QualifiedType BI+type QualifiedTypeNI = QualifiedType NI
+instance (SourceInfo a, Show a) => ToSourceRose QualifiedType a
+instance ASTNode QualifiedType a+instance Data a => Plated (QualifiedType a) where plate = uniplate
+makeLenses ''QualifiedType+deriveSmartTrav ''QualifiedType
+
+type TypeBI = Type BI+type TypeNI = Type NI
+instance (SourceInfo a, Show a) => ToSourceRose Type a
+instance ASTNode Type a+instance Data a => Plated (Type a) where plate = uniplate
+makeLenses ''Type+deriveSmartTrav ''Type
+
+type TypeQualifierBI = TypeQualifier BI+type TypeQualifierNI = TypeQualifier NI
+instance (SourceInfo a, Show a) => ToSourceRose TypeQualifier a
+instance ASTNode TypeQualifier a+instance Data a => Plated (TypeQualifier a) where plate = uniplate
+makeLenses ''TypeQualifier+deriveSmartTrav ''TypeQualifier
+
+type ArrayTypeQualBI = ArrayTypeQual BI+type ArrayTypeQualNI = ArrayTypeQual NI
+instance (SourceInfo a, Show a) => ToSourceRose ArrayTypeQual a
+instance ASTNode ArrayTypeQual a+instance Data a => Plated (ArrayTypeQual a) where plate = uniplate
+makeLenses ''ArrayTypeQual+deriveSmartTrav ''ArrayTypeQual
+
+type StringLiteralBI = StringLiteral BI+type StringLiteralNI = StringLiteral NI
+instance (SourceInfo a, Show a) => ToSourceRose StringLiteral a
+instance ASTNode StringLiteral a+instance Data a => Plated (StringLiteral a) where plate = uniplate
+makeLenses ''StringLiteral+deriveSmartTrav ''StringLiteral
+
+type CompoundLitElemBI = CompoundLitElem BI+type CompoundLitElemNI = CompoundLitElem NI
+instance (SourceInfo a, Show a) => ToSourceRose CompoundLitElem a
+instance ASTNode CompoundLitElem a+instance Data a => Plated (CompoundLitElem a) where plate = uniplate
+makeLenses ''CompoundLitElem+deriveSmartTrav ''CompoundLitElem
+
+type DesignatorBI = Designator BI+type DesignatorNI = Designator NI
+instance (SourceInfo a, Show a) => ToSourceRose Designator a
+instance ASTNode Designator a+instance Data a => Plated (Designator a) where plate = uniplate
+makeLenses ''Designator+deriveSmartTrav ''Designator
+
+type StructUnionBI = StructUnion BI+type StructUnionNI = StructUnion NI
+instance (SourceInfo a, Show a) => ToSourceRose StructUnion a
+instance ASTNode StructUnion a+instance Data a => Plated (StructUnion a) where plate = uniplate
+makeLenses ''StructUnion+deriveSmartTrav ''StructUnion
+
+type EnumerationBI = Enumeration BI+type EnumerationNI = Enumeration NI
+instance (SourceInfo a, Show a) => ToSourceRose Enumeration a
+instance ASTNode Enumeration a+instance Data a => Plated (Enumeration a) where plate = uniplate
+makeLenses ''Enumeration+deriveSmartTrav ''Enumeration
+
+type VariantBI = Variant BI+type VariantNI = Variant NI
+instance (SourceInfo a, Show a) => ToSourceRose Variant a
+instance ASTNode Variant a+instance Data a => Plated (Variant a) where plate = uniplate
+makeLenses ''Variant+deriveSmartTrav ''Variant
+
+-- * Instances for generic AST elements
+
+type ASTListBI e = ASTList e BI
+type ASTListNI e = ASTList e NI
+instance (Show a, ToSourceRose e a, Generic (e a)) => ToSourceRose (ASTList e) a
+instance (ASTNode e a, Generic (e a)) => ASTNode (ASTList e) a
+deriveSmartTrav ''ASTList
+  
+type ASTWrapperBI e = ASTWrapper e BI
+type ASTWrappereNI e = ASTWrapper e NI
+instance (Show a, ToSourceRose e a, Generic (e a)) => ToSourceRose (ASTWrapper e) a
+instance (ASTNode e a, Generic (e a)) => ASTNode (ASTWrapper e) a
+deriveSmartTrav ''ASTWrapper 
+
+type ASTMaybeBI e = ASTMaybe e BI
+type ASTMaybeNI e = ASTMaybe e NI
+instance (Show a, ToSourceRose e a, Generic (e a)) => ToSourceRose (ASTMaybe e) a
+instance (ASTNode e a, Generic (e a)) => ASTNode (ASTMaybe e) a
+deriveSmartTrav ''ASTMaybe
+
+type ASTEitherBI n m = ASTEither n m BI
+type ASTEitherNI n m = ASTEither n m NI
+instance (Show a, ToSourceRose n a, ToSourceRose m a
+         , Generic (n a), Generic (m a)) => ToSourceRose (ASTEither n m) a
+instance (ASTNode n a, ASTNode m a, Generic (n a), Generic (m a)) 
+           => ASTNode (ASTEither n m) a
+deriveSmartTrav ''ASTEither
+           
+type ASTPairBI n m = ASTPair n m BI
+type ASTPairNI n m = ASTPair n m NI
+instance (Show a, ToSourceRose n a, ToSourceRose m a
+         , Generic (n a), Generic (m a)) => ToSourceRose (ASTPair n m) a
+instance (ASTNode n a, ASTNode m a, Generic (n a), Generic (m a)) 
+           => ASTNode (ASTPair n m) a
+deriveSmartTrav ''ASTPair
+
+-- * AST data elements used in C AST nodes
+  
+instance ASTData Bool
+instance ASTData Int
+instance ASTData Char
+instance ASTData String
+instance ASTData Rational
+instance ASTData Integer
+  
+instance ASTData IntLitSize
+instance ASTData IntLitSign
+instance ASTData IntLitSpec
+instance ASTData FloatLitSize
+instance ASTData FloatingSize
+instance ASTData IntSize
+instance ASTData Sign
+
+instance ASTData a => ASTData (Maybe a)
+
+makeLenses ''IntLitSpec
+ MiniC/MiniCPP.hs view
@@ -0,0 +1,92 @@+
+-- | Preprocessor for C
+module MiniC.MiniCPP where
+
+import Text.Parsec
+import Data.Maybe
+import Data.List (find)
+import Control.Monad.Trans.Class (lift)
+import Control.Applicative hiding ((<|>), many, optional)
+import System.Directory
+import System.FilePath
+
+import Text.Preprocess.Parser
+import Text.Parsec.ExtraCombinators
+import MiniC.Parser.Lexical
+
+-- TODO: macro concatenation with ##
+-- TODO: multiline macros with \
+-- TODO: include directories
+  
+cPreproc = defaultPreprocessor 
+  { macroDef = 
+     do try $ newline *> symbol "#define"
+        -- do not capture whitespace from macro value
+        name <- identOrReserved
+        params <- option [] (try (whiteSpace *> openParen) *> (identOrReserved `sepBy1` comma) <* char ')') 
+        val <- manyTill anyChar (skip (lookAhead newline) <|> eof)
+        return $ MacroDef name Just (execMacro name params val)
+      <?> "macro definition"
+  , macroAppl =
+     do name <- try identOrReserved
+        params <- option [] (char '(' *> (macroArg `sepBy1` char ',') <* char ')')
+        return (MacroAppl name params)
+      <?> "macro application"
+  , includeDirective = \file -> 
+     do try $ newline *> symbol "#include"
+        name <- (char '"' *> many (noneOf "\"") <* char '"')
+                   <|> (char '<' *> many (noneOf ">") <* char '>' )
+        let incFile = combine (takeDirectory file) name
+        exist <- lift $ doesFileExist incFile
+        src <- lift $ if exist then readFile incFile else return ""
+        return (src, incFile)
+  , condDirective = \st -> 
+     do ifdef <- try $ newline *> (try (symbol "#ifdef") *> return id
+                                     <|> symbol "#ifndef" *> return not)
+        macro <- identOrReserved
+        let res = ifdef $ isJust (find ((==macro) . name) (defs st))
+        thenB <- (if res then id else revertState) $ preprocess cPreproc
+        elseB <- option [] (try (newline *> string "#else") 
+                             *> (if res then revertState else id) (preprocess cPreproc))
+        newline *> string "#endif" <?> "#endif"
+        return [NoPP (if res then thenB else elseB)]
+  , failDirective = try (newline *> char '#') *> fail "unexpected macro"
+  , identToken = identOrReserved
+  }
+    where execMacro name params val (MacroAppl applName actParams)
+            = let replaceParser :: Parsec String () [PPRes]
+                  pAssoc = zip params actParams
+                  replaceChoice = choice $ map (\(from,to) -> (try (string from) *> return (PPAgain to))) pAssoc
+                                           ++ map (\(from, to) -> (try (string ("#"++from)) *> return (NoPP ("\""++to++"\"")))) pAssoc
+                  replaceParser = many (replaceChoice 
+                                          <|> (NoPP <$> identOrReserved) 
+                                          <|> ((NoPP . (:[])) <$> anyChar)
+                                          )
+               in if name == applName 
+                    then Just $ if length params /= length actParams 
+                           then Left $ name ++ ": Expected " ++ show (length params) 
+                                            ++ " arguments, received " ++ show (length actParams)
+                           else Right $ either (error . ("Macro replace failed: "++) . show) id 
+                                               (runParser replaceParser () "<macroreplace>" val)
+                    else Nothing
+
+                    
+                    
+macroArg :: Monad m => ParsecT String u m String
+macroArg = macroArg' True
+
+macroArg' :: Monad m => Bool -> ParsecT String u m String
+macroArg' commaForb 
+  = concat <$> many (((:[]) <$> noneOf ((if commaForb then (',':) else id) "()'\"")) 
+                       <|> ((\a->"("++a++")") <$> (char '(' *> macroArg' False <* char ')'))
+                       <|> ((\a->['\'',a,'\'']) <$> simpleCharLiteral)
+                       <|> ((\a->'"':a++"\"") <$> simpleStringLiteral)
+                       )
+                       
+    
+-- | The source that could possibly be rewritten if there is a corresponding macro definition.    
+data MacroAppl
+  = MacroAppl { macroApplName :: String
+              , macroApplParams :: [String]
+              }
+
+ MiniC/ParseProgram.hs view
@@ -0,0 +1,48 @@+
+-- | A module to preprocess and parse C programs
+module MiniC.ParseProgram where
+
+import MiniC.Parser
+import MiniC.Parser.Base
+import MiniC.MiniCPP (cPreproc)
+import MiniC.Parser.Lexical (whole)
+import MiniC.SymbolTable (initUserState)
+import MiniC.Semantics
+import MiniC.TransformInfo
+import Text.Preprocess.Parser
+import Text.Preprocess.Rewrites
+
+import Text.Parsec
+import Text.Parsec.Error
+import Data.Either.Combinators
+import Control.Monad.Reader
+import Control.Applicative hiding ((<|>), many, optional)
+import Data.List.Split
+import MiniC.Parser.Lexical
+
+-- | Parse a whole C translation unit.
+parseProgram = parseWithPreproc (whole translationUnit)
+
+-- | Parse something after using the preprocessor on it.
+parseWithPreproc :: CParser a -> String -> String -> IO (Either ParseError a)
+parseWithPreproc parser name src 
+  = do res <- runParserT (preprocessSource cPreproc) ((), initState name) name src
+       case res of
+           Right (preprocessed,((),st)) ->
+             return $ case runReader (runParserT parser initUserState name preprocessed) (rewrites st) of
+                Right tu -> Right tu
+                Left err -> Left $ setErrorPos (correctPos (rewrites st) (errorPos err)) err
+           Left err -> return $ Left $ addErrorMessage (Message "Preprocessor failed") err
+
+ 
+parseQualName :: String -> IO QualifiedName
+parseQualName src = either (error . ("While parsing qualified name: " ++) . show) id
+                     <$> parseWithPreproc (whole qualifiedName) "<qualified name>" src
+            
+qualifiedName :: CParser QualifiedName
+qualifiedName = lexeme $ 
+    QualifiedName <$> (try (string "$::" *> pure ComplexNS) 
+                        <|> (optional (string "::") *> pure NormalNS))
+      <*> (Scope <$> many ( try (many1 alphaNum <* string "::") )) 
+      <*> (transformSourceInfo <$> typeQualifiedIdentifier)
+
+ MiniC/Parser.hs view
@@ -0,0 +1,466 @@+{-# LANGUAGE TupleSections, FlexibleContexts #-}
+
+-- | The parser that generates the Abstract Syntax Tree that is represented in 'MiniC.AST'.
+-- C language elements are highly recursive, so this module could only be broken up
+-- with a lot of effort and increasing complexity with passing functions arguments.
+-- Also the lexical analysis of C requires knowledge about the defined symbols 
+-- (this is the so called "Lexer Hack"), so registering and querying of symbol table elements
+-- is also incorporated into the parser.
+module MiniC.Parser where
+
+import SourceCode.ASTElems
+import SourceCode.Parsec
+import SourceCode.SourceInfo
+import SourceCode.ASTNode
+import MiniC.AST
+import MiniC.Representation
+import MiniC.Semantics(BI)
+import MiniC.Instances
+import MiniC.Helpers
+import MiniC.Parser.Lexical
+import MiniC.Parser.Expr
+import MiniC.Parser.Base
+import MiniC.SourceNotation
+
+import GHC.Generics (Generic)
+import Text.Parsec
+import Text.Parsec.ExtraCombinators
+import Data.Maybe
+import Control.Lens
+import Control.Monad
+import Control.Applicative hiding ((<|>), many, optional)
+import Debug.Trace
+
+-- * Declarations
+
+translationUnit :: CParser TranslationUnitBI
+translationUnit = withInfo $ TranslationUnit <$> astMany declaration
+ 
+declaration :: CParser DeclarationBI
+declaration 
+  = (FuncDecl <$> try functionDeclaration)
+       -- function declarations can be parsed as variable declarations
+       <|> (VarDecl <$> try variableDeclaration)
+       -- type declaration can be a prefix of variable declaration
+       <|> (TypeDecl <$> typeDefinition)
+              
+typeDefinition :: CParser TypeDefinitionBI
+typeDefinition 
+  = withInfo (TypeDefinition <$> definedType <* semicolon) >>= registerDeclaration 
+       
+functionDeclaration :: CParser FunctionDeclarationBI
+functionDeclaration 
+  = withInfo (
+      do storageSpec <- astMany storageSpecifier
+         funcType <- unqualifiedFunctionType
+         asmSpec <- astOptionMaybe asmSpecifier
+         -- register the function early, to be able to recursively call it
+         let funDecl = FunctionDeclaration storageSpec funcType asmSpec
+         withInfo (pure (funDecl ASTNothing)) >>= registerDeclaration
+         -- return the function declaration with body
+         funDecl <$> ((return ASTNothing <* semicolon) 
+                        <|> (ASTJust <$> insideScope' (getId funcType) statement))
+      ) >>= registerDeclaration 
+                          
+variableDeclaration :: CParser VariableDeclarationBI
+variableDeclaration 
+  = -- other things can be parsed as variableDeclaration, but then there is no id
+    onlyWhen "No id in variable definition" 
+             (\vd -> not ( null $ astGetList $ _varDeclDefinitions vd ) 
+                      || isJust (getId $ _qualTypQual (_varDeclQualTyp vd))) $ withInfo (
+        do storage <- astMany storageSpecifier
+           qualTyp <- try qualifiedFunctionType <|> nonFunctionTypeSpec
+           -- to register all separate variables, the multi-declaration must supply additional data
+           let registerDefinition vdef 
+                 = view ast_triple_1 <$> registerDeclaration (ASTTriple vdef storage qualTyp (vdef ^. info))
+           
+           VariableDeclaration storage qualTyp
+              <$> astOptionMaybe asmSpecifier
+              <*> ((ASTJust <$> (symbol "=" *> expressionWithoutComma)) 
+                            <|> (optional comma *> return ASTNothing))
+              <*> (optional comma *> (variableDefinition >>= registerDefinition) `astSepBy` comma)
+              <* semicolon
+    ) >>= registerDeclaration
+              
+parameterDeclaration :: CParser ParameterDeclarationBI
+parameterDeclaration 
+  = withInfo (ParameterDeclaration <$> qualifiedType) >>= registerDeclaration
+              
+-- | Parses a variable definition, without type, possibly with qualifier and/or initialization
+variableDefinition :: CParser VariableDefinitionBI
+variableDefinition = withInfo ( 
+  VariableDefinition <$> typeQualifierWithId
+                     <*> astOptionMaybe asmSpecifier
+                     <*> astOptionMaybe (symbol "=" *> expressionWithoutComma)
+  )
+
+                            
+storageSpecifier :: CParser StorageSpecifierBI
+storageSpecifier = withInfo $ (reserved "auto" *> return Auto) 
+               <|> (reserved "register" *> return Register) 
+               <|> (reserved "static" *> return Static) 
+               <|> (reserved "extern" *> return Extern)
+               <|> (reserved "inline" *> return Inline)
+               
+asmSpecifier :: CParser AsmSpecifierBI
+asmSpecifier = withInfo $ AsmSpecifier <$> (reserved "asm" *> parens simpleStringLiteral)
+               
+-- * Types
+   
+-- | Parses a type with type qualifiers.
+-- Examples: @int@, @int *@, @struct { ... }@, @int *a[10]@, @void f(...)@, ...
+qualifiedType :: CParser QualifiedTypeBI
+qualifiedType = try unqualifiedFunctionType <|> try qualifiedFunctionType <|> nonFunctionTypeSpec
+          
+-- | Examples: @void f()@, @int g(int a)@
+unqualifiedFunctionType :: CParser QualifiedTypeBI
+unqualifiedFunctionType = functionType scalarWithId
+
+-- | Examples: @void (*f)()@, @void (*)()@, @void (f[10])()@
+qualifiedFunctionType :: CParser QualifiedTypeBI
+qualifiedFunctionType = functionType typeQualifiedIdentifier
+        
+-- | Parses a function type with a parser given to parse the qualified or unqualified function name.
+functionType :: CParser TypeQualifierBI -> CParser QualifiedTypeBI
+functionType qualParser 
+  = withInfo $
+      do retTyp <- returnTypeSpec
+         qualId <- qualParser
+         -- parameters are in the scope of the function
+         let paramDecl = insideScope' (getId qualId) parameterDeclaration
+         QualifiedType qualId <$>
+            withInfo (FunType retTyp 
+                           <$> withInfo (ASTWrapper <$> parens (paramDecl `astSepBy` comma)))      
+
+-- | First parse a nonrecursive type, then parse any 
+nonFunctionTypeSpec :: CParser QualifiedTypeBI
+nonFunctionTypeSpec = withInfo $ 
+                        flip applyQualTo <$> nonRecursiveTypeSpec 
+                                         <*> typeQualifiedIdentifier 
+           
+-- | Parses a type without identifier. The identifier-related type qualifiers will
+-- not be parsed unless there is no identifier.
+-- Examples: @float@, @int*[10]@, @const int*[10]@
+returnTypeSpec :: CParser QualifiedTypeBI
+returnTypeSpec = withInfo $ 
+                   flip applyQualTo <$> nonRecursiveTypeSpec 
+                                    <*> typeQualifierNoId
+              
+-- | Type qualifiers with or without identifier
+-- Examples: @*[10]@, @*a[10]@, @(*a)[10]@
+typeQualifiedIdentifier :: CParser TypeQualifierBI
+typeQualifiedIdentifier = try typeQualifierWithId
+              <|> try (withInfo $ ParenQual <$> parens typeQualifierWithIdStrict)
+              <|> withInfo (ParenQual <$> parens typeQualifierNoId)
+              <|> typeQualifierNoId
+         
+-- | Examples: @*[10]@ in @int*[10]@          
+-- Semantics: @int*[10]@ = array of ptrs to ints
+typeQualifierNoId :: CParser TypeQualifierBI
+typeQualifierNoId 
+  = ((beforeQual <*> typeQualifierNoId) 
+          <|> inheritInfo (ArrayQual <$> afterQual <*> typeQualifierNoId))
+      <|> scalarNoId
+               
+              
+-- | Type qualifiers with an identifier, for example @*a[10]@ in @int *a[10]@,
+-- @*(*a[10])[10]@
+-- Semantics: int **(*a)[2][3] = ptr to array[2] of array[3] of ptr to ptr to int
+typeQualifierWithId :: CParser TypeQualifierBI
+typeQualifierWithId 
+  = let noParenWhenNotNeeded bef inner aft 
+         = guard $ not (null bef && null aft 
+                                 && case inner of ParenQual {} -> True; _ -> False)
+     in typeQualifierWithId' noParenWhenNotNeeded
+
+typeQualifierWithIdStrict 
+  = let doesNeedParenOutside bef _ aft = guard $ not (null bef && null aft)
+     in typeQualifierWithId' doesNeedParenOutside
+
+typeQualifierWithId' guard
+  = do before <- many beforeQual
+       inner <- withInfo (ParenQual <$> parens typeQualifierWithId) 
+                  <|> scalarWithId
+       arrs <- many afterQual
+       guard before inner arrs
+       return (foldr ($) (foldl (\tq ar -> ArrayQual ar tq noNodeInfo) inner arrs) before)      
+       
+-- | Parses a qualifier that stand between the type and the id
+beforeQual :: CParser (TypeQualifierBI -> TypeQualifierBI)
+beforeQual = withInfo (flip <$> (reservedOp "*" *> pure PtrQual)) 
+               <|> typBoundedQual
+         
+-- | Parses an array qualifier         
+afterQual :: CParser ArrayTypeQualBI
+afterQual 
+  = withInfo $ brackets $ ArrayTypeQual 
+               <$> astOptionMaybe ((typBoundedQual <*> scalarNoId)
+                                              <|> withInfo (reserved "static" *> return StaticQual))
+               <*> astOptionMaybe expression 
+
+-- | Parses a qualifier that can happen before and after the type
+typBoundedQual :: CParser (TypeQualifierBI -> TypeQualifierBI)
+typBoundedQual = withInfo $ flip <$> (
+   (reserved "const" *> pure ConstQual)
+      <|> (reserved "volatile" *> pure VolatileQual)
+      <|> (reserved "restrict" *> pure RestrictQual) )
+
+-- | Parses a type that does not capture identifier and identifier-bounded type qualifiers
+-- Examples : @void@, @const int@, @(const int* a[10])@
+nonRecursiveTypeSpec :: CParser QualifiedTypeBI
+nonRecursiveTypeSpec = 
+   withInfo (QualifiedType <$> scalarNoId <*> unqualifiedType)
+     <|> withInfo (applyQualTo <$> ( typBoundedQual <*> scalarNoId ) 
+                               <*> nonRecursiveTypeSpec)
+ 
+scalarNoId = withInfo $ pure (Scalar ASTNothing)
+scalarWithId = withInfo (Scalar <$> ASTJust <$> identifier)
+  
+unqualifiedType :: CParser TypeBI
+unqualifiedType = 
+      withInfo (reserved "void" *> return VoidType)
+  <|> withInfo (reserved "bool" *> return BoolType)
+  <|> withInfo (IntType <$> integerSign <*> integerSize)
+  <|> withInfo (FloatingType <$> floatingSize)
+  <|> (TypeName <$> (identifier >>= checkIsTypeSymbol))
+  <|> withInfo (reserved "typeof" *> parens ( (TypeOfExpr <$> expression) 
+                                                 <|> (TypeOfType <$> try returnTypeSpec) ))
+  <|> definedType
+  
+-- | A type that can be defined in a type definition. May have an identifier.
+definedType :: CParser TypeBI
+definedType = withInfo $ (StructType <$> (reserved "struct" *> structUnionType))
+              <|> (UnionType <$> (reserved "union" *> structUnionType) )
+              <|> (EnumType <$> (reserved "enum" *> enumeration) )       
+              <|> (TypeDef <$> (reserved "typedef" *> qualifiedType) 
+                           <*> astOptionMaybe identifier)  
+
+integerSign :: CParser Sign
+integerSign = (reserved "unsigned" *> return Unsigned)
+                <|> (optional (reserved "signed") *> return Signed)
+                              
+integerSize :: CParser IntSize
+integerSize = reserved "char" *> return Char 
+  <|> reserved "short" *> optional (reserved "int") *> return Short 
+  <|> reserved "int" *> return Int 
+  <|> reserved "long" *> optional (reserved "int") *> return LongInt 
+  <|> reserved "long" *> reserved "long" *> optional (reserved "int") *> return LongLongInt 
+
+floatingSize :: CParser FloatingSize
+floatingSize = reserved "float" *> return Float 
+  <|> reserved "double" *> return Double 
+  <|> reserved "long" *> reserved "double" *> return LongDouble
+
+enumeration :: CParser EnumerationBI
+enumeration 
+  = withInfo $ Enumeration 
+                 <$> astOptionMaybe identifier 
+                 <*> astOptionMaybe ( braces (withInfo $ ASTCons <$> variant 
+                                                                 <*> astMany (try $ comma *> variant) 
+                                                                 <* optional comma))
+
+variant :: CParser VariantBI
+variant = withInfo $ Variant <$> identifier 
+                      <*> astOptionMaybe (reservedOp "=" *> expression)
+
+structUnionType :: CParser StructUnionBI
+structUnionType = withInfo $ do
+  id <- astOptionMaybe identifier
+  StructUnion id <$> astOptionMaybe (braces (astMany (insideScope' (view astMaybe id) declaration)))
+                              
+-- * Statements
+
+statement :: CParser StatementBI
+statement = withInfo $
+      try (Label <$> identifier <* colon <*> statement <?> "labeled statement")
+  <|> (reserved "case" *> ( 
+        try (CaseInterval <$> (ASTPair <$> expression <* reservedOp ".." <*> expression) <* colon <*> statement) 
+          <|> (Case <$> expression <* colon <*> statement) ) )
+  <|> (Default <$> (reserved "default" *> colon *> statement))
+  <|> try (Expr <$> expression <* semicolon)
+  <|> (Compound <$> (openBrace *> insideAnonymScope (astMany (try (astParseEither (try declaration) statement ))) <* closeBrace 
+         <?> "compound statement"))
+  <|> (If <$> (reserved "if" *> parens expression) <*> statement 
+          <*> astOptionMaybe (reserved "else" *> statement))
+  <|> (Switch <$> (reserved "switch" *> parens expression) <*> statement)
+  <|> (While <$> (reserved "while" *> parens expression) <*> statement)
+  <|> (DoWhile <$> (reserved "do" *> statement) 
+               <*> (reserved "while" *> parens expression <* semicolon))
+  <|> insideAnonymScope (
+         For <$> (reserved "for" *> openParen 
+                                 *> astOptionMaybe (astParseEither (try expression <* semicolon) declaration) )
+             <*> astOptionMaybe expression <* semicolon
+             <*> astOptionMaybe expression <* closeParen 
+             <*> statement )
+  <|> (Goto <$> (reserved "goto" *> expression) <* semicolon)
+  <|> (reserved "continue" *> return Continue <* semicolon)
+  <|> (reserved "break" *> return Break <* semicolon)
+  <|> (Return <$> (reserved "return" *> astOptionMaybe expression) <* semicolon)
+  <|> (semicolon *> return EmptyStmt <?> "empty instruction")
+  <|> (AsmStmt <$> (reserved "asm" *> withInfo
+        (InlineAssembly <$> ifAccept (reserved "volatile") 
+                        <*> (openParen *> astMany (withInfo $ AssemblyString <$> simpleStringLiteral)) 
+                        <*> astOptionMaybe (colon *> asmParams) 
+                        <*> astOptionMaybe (colon *> asmParams) 
+                        <*> astOptionMaybe (colon *> asmParams) ) <* closeParen <* semicolon ) )
+  
+asmParams :: CParser (ASTListBI AssemblyParam)
+asmParams = withInfo (AssemblyParam <$> simpleStringLiteral 
+                                    <*> astOptionMaybe (parens identifier)) `astSepBy` comma
+                       
+-- * Expressions
+
+expression = chainl1 expressionWithoutComma 
+                     (do operator <- withInfo (comma *> return CommaOp) 
+                         return (\e1 e2 -> Binary operator e1 e2 noNodeInfo))
+                     
+-- | Expressions without comma need special treatment, because they
+-- cannot appear in function calls.    
+expressionWithoutComma = genExpression term
+
+genExpression :: CParser ExpressionBI -> CParser ExpressionBI
+genExpression term = buildExpressionParser precedenceTable (unaryExpressionWithSizeOf term) <?> "expression"
+  where precedenceTable = 
+          [ -- arithmetic operators
+            [ binOpL "*" MulOp
+            , binOpL "/" DivOp
+            , binOpL "%" RemainderOp 
+            ]
+          , [ binOpL "+" AddOp
+            , binOpL "-" SubOp
+            ]
+          -- bit shifting
+          , [ binOpL ">>" ShiftLeftOp
+            , binOpL "<<" ShiftRightOp
+            ]
+          -- compare operators
+          , [ binOpL ">" LessOp
+            , binOpL "<" GreaterOp
+            , binOpL ">=" LessOrEqOp
+            , binOpL "<=" GreaterOrEqOp
+            ] 
+          , [ binOpL "==" EqOp
+            , binOpL "!=" NotEqOp
+            ]
+          -- bitwise operators
+          , [ binOpL "&" BitAndOp ] 
+          , [ binOpL "^" BitXorOp ]
+          , [ binOpL "|" BitOrOp ]
+          -- logic operators
+          , [ binOpL "&&" LogicAndOp ]
+          , [ binOpL "||" LogicOrOp ]
+          -- ternary conditional op
+          , [ Infix ((\e2 e1 e3 -> Cond e1 e2 e3 noNodeInfo) 
+                       <$> (reservedOp "?" *> astOptionMaybe expression <* reservedOp ":")
+                    ) AssocRight ]
+          -- assignments
+          , [ binOpR "=" AssignOp
+            , binOpR "*=" MulAssOp
+            , binOpR "/=" DivAssOp
+            , binOpR "%=" RemainderAssOp
+            , binOpR "+=" AddAssOp
+            , binOpR "-=" SubAssOp
+            , binOpR "<<=" ShiftLeftAssOp
+            , binOpR ">>=" ShiftRightAssOp
+            , binOpR "&=" BitAndAssOp
+            , binOpR "^=" BitXorAssOp
+            , binOpR "|=" BitOrAssOp
+            ]
+          ]
+          
+        binOpL sign sema = Infix (binOp sign sema) AssocLeft
+        binOpR sign sema = Infix (binOp sign sema) AssocRight
+        
+        binOp sign sema 
+          = do operator <- withInfo (reservedOp sign *> return sema)
+               return (\e1 e2 -> Binary operator e1 e2 noNodeInfo) <?> "binary operator"
+  
+-- | Sizeof needs a special treatment because it can either be used on types and expressions,
+-- and has the same precedence in both cases.  
+unaryExpressionWithSizeOf :: CParser ExpressionBI -> CParser ExpressionBI
+unaryExpressionWithSizeOf term
+  = withInfo (reserved "sizeof" *> parens ((SizeOfExpr <$> try expression) 
+                                               <|> (SizeOfType <$> qualifiedType)))
+      <|> unaryExpression term
+        
+unaryExpression :: CParser ExpressionBI -> CParser ExpressionBI
+unaryExpression term = buildExpressionParser precedenceTable term <?> "expression"
+  where precedenceTable = 
+          [ [ Postfix $ unaryOp "++" PostIncOp
+            , Postfix $ unaryOp "--" PostDecOp 
+            ]
+          , [ Prefix $ unaryOp "++" PreIncOp
+            , Prefix $ unaryOp "--" PreDecOp 
+            , Prefix $ unaryOp "&" AddressOp
+            , Prefix $ unaryOp "*" DereferenceOp
+            , Prefix $ unaryOp "+" PrePlusOp
+            , Prefix $ unaryOp "-" PreMinOp
+            , Prefix $ unaryOp "~" ComplementOp
+            , Prefix $ unaryOp "!" LogicNegOp
+            ]
+          ]
+        unaryOp sign sema = do operator <- withInfo (reservedOp sign *> return sema) 
+                               return (\expr -> Unary operator expr noNodeInfo)
+        
+term :: CParser ExpressionBI
+term = do base <- nonrecursiveTerm
+          termIndexes base
+        <?> "term"
+        
+-- | Tries to parse an array indexing, member access or function call 
+--     and applies it to the given expressions. 
+-- If does not succeed gives back the original expression.
+-- This definition must be separated otherwise grammar would be left-recursive.
+termIndexes :: ExpressionBI -> CParser ExpressionBI
+termIndexes base 
+  = (inheritInfo ( 
+         (Indexing base <$> withInfo (ArrayIndex <$> brackets expression) )
+            <|> (Member base <$> withInfo ((reservedOp "." *> pure SimpleMember) 
+                                              <|> (reservedOp "->" *> pure DerefMember))
+                             <*> identifier)
+            <|> (Call base <$> withInfo (ASTWrapper <$> parens (expressionWithoutComma `astSepBy` comma)))
+         ) >>= termIndexes)
+    <|> return base
+        
+nonrecursiveTerm :: CParser ExpressionBI
+nonrecursiveTerm = withInfo $
+  (try $ Cast <$> parens qualifiedType <*> expression)
+  -- can be prefix of type cast
+  <|> (ParenExpr <$> parens expression)
+  <|> (LitExpr <$> try literal)
+  <|> (NameExpr <$> (identifier >>= checkIsExpression))
+  
+literal :: CParser LiteralBI
+literal = (try float 
+    <|> integer -- integer literal can be a prefix of a float literal
+    <|> try charLiteral
+    <|> (StrLitList <$> astMany1 stringLiteral)
+    <|> (withInfo $ CompoundLit <$> braces (compoundElem `astSepBy` comma))
+  ) <?> "literal"
+
+compoundElem :: CParser CompoundLitElemBI
+compoundElem 
+  = withInfo $
+     ( CompoundLitElem <$> astMany1 ( withInfo $ ( MemberDesignator <$> (symbol "." *> identifier) )
+                                  <|> ( ArrDesignator <$> brackets expression ) )
+          <*> ( symbol "=" *> expressionWithoutComma ) )
+     <|> (CompoundLitElem <$> pure ASTNil <*> expressionWithoutComma)
+
+-- * Helper parsers. Used to parse common AST elements in special ways.
+            
+astMany :: CParser (e BI) -> CParser (ASTList e BI)
+astMany p = withInfo (ASTCons <$> p <*> astMany p) <|> pure ASTNil
+
+astMany1 :: CParser (e BI) -> CParser (ASTList e BI)
+astMany1 p = withInfo (ASTCons <$> p <*> astMany p)
+
+astSepBy :: CParser (e BI) -> CParser sep -> CParser (ASTList e BI)
+astSepBy p sep = astSepBy1 p sep <|> pure ASTNil
+
+astSepBy1 :: CParser (e BI) -> CParser sep -> CParser (ASTList e BI)
+astSepBy1 p sep = withInfo (ASTCons <$> p <*> astMany (sep *> p))
+
+astOptionMaybe :: CParser (e BI) -> CParser (ASTMaybe e BI)
+astOptionMaybe = (view (from astMaybe) <$>) . optionMaybe
+     
+
+ MiniC/Parser/Base.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses
+           , OverlappingInstances, TupleSections, ScopedTypeVariables #-}
+
+-- | Parser combinators to handle additional information assigned to AST nodes.
+-- Has functions to handle source information and semantic information.
+module MiniC.Parser.Base where
+
+import MiniC.Representation
+import MiniC.SourceNotation
+import MiniC.SymbolTable
+import MiniC.Semantics
+import MiniC.Helpers
+import MiniC.Instances
+import MiniC.AST
+import SourceCode.ASTNode
+import SourceCode.ASTElems
+import SourceCode.SourceTree
+import SourceCode.SourceInfo
+import Text.Preprocess.Rewrites
+
+import Data.Maybe
+import qualified Data.Map as M
+import Data.Function
+import Data.List
+import Text.Parsec
+import Text.Parsec.PosOps
+import Text.Parsec.ExtraCombinators
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Applicative hiding ((<|>), many)
+import Control.Lens
+import Debug.Trace
+
+-- * C parser types
+type CParser a = ParsecT CStream (CUserState BI) CMonad a
+type CStream = String
+type CMonad = Reader RewriteSet
+type SymbolEntryBI = SymbolEntry BI
+
+-- Overrides the normal MonadState instance for a parser that relies on an underlying
+-- state monad. But we need to use user state, because it resets when parsing one 
+-- alternative fails.
+instance MonadState (CUserState a) (ParsecT CStream (CUserState a) CMonad) where
+  get = getState
+  put = setState
+
+-- * Handling source info
+
+-- | Adds node information to a parsed AST node.
+-- Composes the source template by cutting out children nodes.
+withInfo :: CParser (BI -> b) -> CParser b
+withInfo p = do inp <- getInput
+                (res, sr) <- captureSourceRange p
+                return $ res (NodeInfo (BasicInfo sr inp) emptySemaInfo)
+                
+-- | Orders the parsed AST node to compose it's node information from it's children.
+inheritInfo :: CParser (BI -> b BI) -> CParser (b BI)
+inheritInfo p = p <*> pure noNodeInfo
+        
+-- | Replaces the node information in a node with the current node information.
+-- Discards node information composed by 'unifyInfo'
+withNewInfo :: (ASTNode a BI) => CParser (a BI) -> CParser (a BI)
+withNewInfo p = withInfo (p >>= \res -> return $ \inf -> setInfo inf res) 
+      
+-- * Handling semantic info
+      
+-- | Nodes that represent some kind of declaration that can be put into the symbol table
+class CanBeRegistered node where
+  -- | Gets the namespace of the declaration
+  nameSpace :: node ni -> NameSpace
+  nameSpace _ = NormalNS
+  
+  -- | Creates a symbol table entry from qualified name and declaration
+  createEntry :: SourceInfo ni => QualifiedName -> node ni -> SymbolEntry ni
+  
+-- | Adds a declaration to the symbol table. Solves redeclaration.
+registerDeclaration :: forall node . (Show (node BI), Id node BI, ASTNode node BI, CanBeRegistered node) => node BI -> CParser (node BI)
+registerDeclaration decl
+  | Just name <- view identStr <$> getId decl
+  = do qualName <- inScope (nameSpace decl) name
+       let decl' = decl & info.semanticInfo.declQualName .~ Just qualName 
+       symbolTable.symbolMap %= M.insert qualName (createEntry qualName decl')
+       return decl'
+-- when the declaration has no name (for example: anonymous parameter) do not register
+registerDeclaration decl
+  = return decl
+  
+instance CanBeRegistered VariableDeclaration where
+  createEntry _ (VariableDeclaration ss qt asm init _ info) 
+    = VariableEntry (astGetList ss) qt (asm ^. astMaybe) (init ^. astMaybe) info
+  
+instance CanBeRegistered (ASTTriple VariableDefinition (ASTList StorageSpecifier) QualifiedType) where
+  createEntry _ (ASTTriple (VariableDefinition qual asm init info) ss qt _) 
+    = VariableEntry (astGetList ss) (applyQualTo qual qt noNodeInfo) (asm ^. astMaybe) (init ^. astMaybe) info
+      
+instance CanBeRegistered ParameterDeclaration where
+  createEntry _ = ParameterEntry
+      
+instance CanBeRegistered FunctionDeclaration where
+  createEntry _ = FunctionEntry
+            
+instance CanBeRegistered TypeDefinition where
+  nameSpace td = case td ^. typeDefType of TypeDef {} -> NormalNS
+                                           _ -> ComplexNS
+  createEntry _ = TypeEntry
+            
+instance CanBeRegistered Variant where
+  createEntry _ = VariantEntry
+                   
+-- | Parses the given declaration in an inner scope  
+insideScope :: String -> CParser a -> CParser a
+insideScope s p = do currentScope %= \(Scope sx) -> Scope (s:sx)
+                     currentIds %= (0:)
+                     res <- p
+                     currentScope %= \(Scope sx) -> Scope (tail sx)
+                     currentIds %= tail
+                     return res
+       
+-- | Parses the given declaration inside an anonym scope 
+-- (for example: anonym structs, compound stmts)
+insideAnonymScope :: CParser a -> CParser a
+insideAnonymScope p 
+  = do let currentId = currentIds . ix 0
+       id <- gets (head . view currentIds)
+       currentId += 1
+       insideScope (show id) p
+       
+insideScope' :: Maybe (Ident ni) -> CParser a -> CParser a
+insideScope' (Just id) = insideScope (view identStr id)
+insideScope' Nothing = insideAnonymScope
+
+-- | Gets the qualified name of an id in current scope
+inScope :: NameSpace -> String -> CParser QualifiedName
+inScope ns s = QualifiedName ns <$> gets (view currentScope) <*> pure (genScalarQual s)
+  where genScalarQual s = Scalar (ASTJust (Ident s (noNodeInfo & sourceInfo.niTemplate .~ Just [TextElem s]))) 
+                                 (noNodeInfo & sourceInfo.niTemplate .~ Just [NodeElem (NthChildOf 0 (NthChildOf 0 Current))])        
+          
+-- | Looks up a name in the symbol table
+lookupName' :: NameSpace -> String -> CParser (Maybe (QualifiedName, SymbolEntryBI))
+lookupName' ns s = do qname <- inScope ns s
+                      gets (lookupSymbol qname . view symbolTable)
+
+lookupName = lookupName' NormalNS
+
+lookupNameBoth :: String -> CParser (Maybe (QualifiedName, SymbolEntryBI))
+lookupNameBoth s = mplus <$> lookupName' NormalNS s <*> lookupName' ComplexNS s
+           
+-- | Checks that a given name represents a type
+checkIsTypeSymbol :: IdentBI -> CParser IdentBI
+checkIsTypeSymbol res 
+  = do let simpleName = res ^. identStr
+       entry <- lookupNameBoth simpleName
+       case entry of 
+         Just (name, TypeEntry {}) -> return (res & identInfo.semanticInfo.referenceQualName .~ Just name)
+         _ -> fail $ "Unknown type name: " ++ simpleName
+ 
+-- | Checks that the given name can appear in an expression
+checkIsExpression :: IdentBI -> CParser IdentBI
+checkIsExpression res
+  = do let simpleName = res ^. identStr
+       entry <- lookupName simpleName
+       case entry of 
+         Nothing -> fail $ "Unknown name: " ++ simpleName
+         Just (name, TypeEntry {}) -> fail $ "Value expected, type found: " ++ simpleName
+         Just (name, _) -> return (res & identInfo.semanticInfo.referenceQualName .~ Just name)
+
+debugSymbolTable :: CParser ()
+debugSymbolTable
+  = gets (show . (each._2 %~ take 40 . show) . M.assocs . view (symbolTable.symbolMap)) 
+      >>= flip trace (return ())
+ MiniC/Parser/Expr.hs view
@@ -0,0 +1,84 @@+
+-- | A copy of Text.Parsec.Expr with a minor change.
+-- The Parsec version lacked the support to parse multiple unary operators.
+module MiniC.Parser.Expr 
+  ( MiniC.Parser.Expr.buildExpressionParser
+  , Assoc(..), Operator(..), OperatorTable
+  ) where
+
+import Text.Parsec
+import Text.Parsec.Expr
+
+buildExpressionParser :: (Stream s m t)
+                      => OperatorTable s u m a
+                      -> ParsecT s u m a
+                      -> ParsecT s u m a
+buildExpressionParser operators simpleExpr
+    = foldl makeParser simpleExpr operators
+    where
+      makeParser term ops
+        = let (rassoc,lassoc,nassoc
+               ,prefix,postfix)      = foldr splitOp ([],[],[],[],[]) ops
+
+              rassocOp   = choice rassoc
+              lassocOp   = choice lassoc
+              nassocOp   = choice nassoc
+              prefixOp   = choice prefix  <?> ""
+              postfixOp  = choice postfix <?> ""
+
+              ambigious assoc op = try $ op >> fail ("ambiguous use of a " ++ assoc
+                                                 ++ " associative operator")
+
+              ambigiousRight    = ambigious "right" rassocOp
+              ambigiousLeft     = ambigious "left" lassocOp
+              ambigiousNon      = ambigious "non" nassocOp
+
+              termP      = do { pre  <- many prefixOp
+                              ; x    <- term
+                              ; post <- many postfixOp
+                              ; return (foldl (flip ($)) (foldr ($) x pre) post)
+                              }
+
+              rassocP x  = do { f <- rassocOp
+                              ; y  <- do{ z <- termP; rassocP1 z }
+                              ; return (f x y)
+                              }
+                           <|> ambigiousLeft
+                           <|> ambigiousNon
+
+              rassocP1 x = rassocP x  <|> return x
+
+              lassocP x  = do { f <- lassocOp
+                              ; y <- termP
+                              ; lassocP1 (f x y)
+                              }
+                           <|> ambigiousRight
+                           <|> ambigiousNon
+
+              lassocP1 x = lassocP x <|> return x
+
+              nassocP x  = do { f <- nassocOp
+                              ; y <- termP
+                              ;    ambigiousRight
+                               <|> ambigiousLeft
+                               <|> ambigiousNon
+                               <|> return (f x y)
+                              }
+
+           in do { x <- termP
+                 ; rassocP x <|> lassocP  x <|> nassocP x <|> return x
+                   <?> "operator"
+                 }
+
+
+      splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)
+        = case assoc of
+            AssocNone  -> (rassoc,lassoc,op:nassoc,prefix,postfix)
+            AssocLeft  -> (rassoc,op:lassoc,nassoc,prefix,postfix)
+            AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)
+
+      splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)
+        = (rassoc,lassoc,nassoc,op:prefix,postfix)
+
+      splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)
+        = (rassoc,lassoc,nassoc,prefix,op:postfix)
+ MiniC/Parser/Lexical.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}
+
+-- | Lexer for C. Parts from 'Text.Parsec.Token' have been copied here, because they
+-- could not handle source information, or literal type specification, so it may
+-- be considered as a reimplementation of common lexical elements.
+module MiniC.Parser.Lexical where
+
+import MiniC.AST
+import MiniC.Instances
+import MiniC.Parser.Base
+import MiniC.Representation
+
+import Data.Char (digitToInt)
+import Control.Lens
+import Control.Applicative hiding ((<|>), many, optional)
+import Text.Parsec
+import Text.Parsec.Token ( GenLanguageDef(..))
+import qualified Text.Parsec.Token as P
+
+cStyle :: Monad m => GenLanguageDef CStream u m
+cStyle = LanguageDef
+           { commentStart    = "/*"
+           , commentEnd      = "*/"
+           , commentLine     = "//"
+           , nestedComments  = False
+           , identStart      = letter <|> oneOf "_"
+           , identLetter	 = alphaNum <|> oneOf "_"
+           , opStart         = oneOf ""
+           , opLetter        = oneOf ""
+           , reservedOpNames = []
+           , reservedNames   = []
+           , caseSensitive   = True
+           }
+           
+cDef :: Monad m => GenLanguageDef CStream u m
+cDef = cStyle 
+         { reservedNames = [ "asm", "auto", "break", "bool", "case", "char", "const", "continue"
+                           , "default", "do", "double", "else", "enum", "extern"
+                           , "float", "for", "goto", "if", "int", "long", "register"
+                           , "return", "restrict", "short", "signed", "sizeof", "static"
+                           , "struct" , "switch", "typedef", "typeof", "union", "unsigned", "void"
+                           , "volatile", "while" 
+                           ]
+         }
+
+lexer :: Monad m => P.GenTokenParser CStream u m
+lexer = P.makeTokenParser cDef    
+  
+  
+
+whole :: CParser a -> CParser a
+whole p = whiteSpace *> p <* eof
+  
+-- * Inherited tokens
+lexeme :: Monad m => ParsecT CStream u m a -> ParsecT CStream u m a
+lexeme = P.lexeme lexer
+
+symbol :: Monad m => String -> ParsecT CStream u m String
+symbol = P.symbol lexer
+  
+parens, braces, brackets :: Monad m => ParsecT CStream u m a -> ParsecT CStream u m a
+parens = P.parens lexer
+braces = P.braces lexer
+brackets = P.brackets lexer
+
+identifier = lexeme $ withInfo $ Ident <$> noWSIdentifier
+
+simpleIdentifier :: Monad m => ParsecT String u m String
+simpleIdentifier = lexeme noWSIdentifier
+
+noWSIdentifier :: forall u m . Monad m => ParsecT String u m String
+noWSIdentifier = try $
+     do name <- identOrReserved
+        if name `elem` reservedNames (cDef :: GenLanguageDef CStream u m)
+         then unexpected ("reserved word " ++ show name)
+         else return name
+
+identOrReserved :: Monad m => ParsecT String u m String
+identOrReserved = (:) <$> identStart cDef <*> many (identLetter cDef) <?> "identifier"
+
+reserved :: Monad m => String -> ParsecT String u m ()
+reserved = P.reserved lexer
+
+-- | This function decides which symbol can follow another symbol while the whole lexeme remains
+-- a valid C operator.
+opNoFollow op 
+  = concat $ ["=" | op `elem` ["+","-","*","/","%","&","^","|","<",">","<<",">>"]]
+               ++ [op | op `elem` ["&","|","+","-",">","<"]]
+               ++ [">" | op == "-"]
+               
+reservedOp :: String -> CParser ()
+reservedOp name 
+  = try $ lexeme (string name) 
+            >> (notFollowedBy (oneOf $ opNoFollow name) <?> ("end of " ++ show name))
+
+whiteSpace :: Monad m => ParsecT String u m ()
+whiteSpace = P.whiteSpace lexer
+
+comma, colon, semicolon, openParen, closeParen
+  , openBrace, closeBrace, openBracket, closeBracket :: Monad m => ParsecT String u m String
+comma = symbol ","
+colon = symbol ":"
+semicolon = symbol ";"
+openParen = symbol "("
+closeParen = symbol ")"
+openBrace = symbol "{"
+closeBrace = symbol "}"
+openBracket = symbol "["
+closeBracket = symbol "]"
+
+---------------------
+-- number literals --
+---------------------
+
+-- integer literals
+integer :: CParser LiteralBI
+integer = lexeme $ withInfo $ IntLit <$> (sign <*> nat) <*> integerSuffix
+
+nat = zeroNumber <|> decimal
+int = lexeme sign <*> nat
+sign = (char '-' *> return negate) <|> (optional (char '+') *> return id)
+zeroNumber = char '0' *> (hexadecimal <|> binary <|> octal <|> return 0) <?> ""
+
+decimal = P.decimal lexer
+hexadecimal = P.hexadecimal lexer
+octal = number 8 octDigit
+binary = oneOf "bB" *> number 2 (oneOf "01")
+
+-------------------------------
+-- * floating point literals --
+-------------------------------
+
+float :: CParser LiteralBI
+float = lexeme floating <?> "float literal"
+
+floating = withInfo $ FloatLit 
+  <$> ( try (char '0' *> oneOf "xX" *> floatingBase hexDigit 16 (oneOf "pP"))
+           <|> floatingBase digit 10 (oneOf "eE")) 
+  <*> optionMaybe fractSuffix 
+
+floatingBase :: CParser Char -> Integer -> CParser a -> CParser Rational
+floatingBase digit baseNum exponentSign 
+  = try ( combine (option 0 integralPart) (char '.' *> fractionPart) (option 1 exponentPart) )
+      <|> try ( combine (integralPart <* char '.') (option 0 fractionPart) (option 1 exponentPart) )
+      <|> combine integralPart (option 0 (char '.' *> fractionPart)) exponentPart
+  where combine ip fp ep = (*) <$> ( (+) <$> ip <*> fp ) <*> ep
+        integralPart = fromIntegral <$> number baseNum digit
+        fractionPart = fractNumber baseNum digit
+        exponentPart = exponentSign *> ((fromIntegral baseNum ^) <$> (sign <*> decimal))
+               
+fractSuffix 
+  = (oneOf "fF" *> return LitFloat) <|> (oneOf "lL" *> return LitLongDouble)
+               
+integerSuffix = do suffs <- many (intSignSuffix <|> intSizeSuffix)
+                   return $ foldl (flip ($)) (IntLitSpec Nothing Nothing) suffs 
+                 
+intSignSuffix = try (oneOf "uU") *> return (set intLitSign (Just LitUnsigned) )
+
+intSizeSuffix = (try (string "ll" <|> string "LL") *> return (set intLitSize (Just LitLongLong)))
+                  <|> (try (oneOf "lL") *> return (set intLitSize (Just LitLong)))
+
+number :: Monad m => Integer -> ParsecT CStream u m Char -> ParsecT CStream u m Integer
+number base baseDigit
+    = do{ digits <- many1 baseDigit
+        ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits
+        ; seq n (return n)
+        }
+
+fractNumber :: Integer -> CParser Char -> CParser Rational
+fractNumber (fromIntegral -> base) baseDigit
+    = do{ digits <- many1 baseDigit
+        ; let (n,e) = foldl (\(x,e) d -> (x + (fromIntegral (digitToInt d) / e), e * base)) (0,base) digits
+        ; seq n (return n)
+        }
+
+hexaNum :: Monad m => ParsecT CStream u m Integer
+hexaNum = number 16 hexDigit
+                 
+--------------------------------
+-- * Char and String literals --
+--------------------------------
+         
+unicodePrefix = option False (oneOf "lL" *> return True)      
+
+charLiteral     
+  = withInfo ( lexeme $ CharLit <$> unicodePrefix
+                 <*> simpleCharLiteral )
+      <?> "character"
+
+simpleCharLiteral :: Monad m => ParsecT CStream u m Char
+simpleCharLiteral = between (char '\'')
+                            (char '\'' <?> "end of character")
+                                characterChar
+
+characterChar :: Monad m => ParsecT CStream u m Char                                
+characterChar   = do c <- (Just <$> charLetter) <|> escapeCode
+                     case c of Just x -> return x
+                               Nothing -> characterChar
+                <?> "literal character"
+
+charLetter :: Monad m => ParsecT CStream u m Char                                                
+charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))
+
+stringLiteral 
+  = withInfo ( StringLiteral <$> unicodePrefix
+                             <*> simpleStringLiteral
+                             <?> "literal string")
+
+simpleStringLiteral :: Monad m => ParsecT CStream u m String
+simpleStringLiteral 
+  = lexeme $ foldr (maybe id (:)) ""
+          <$> between (char '"') (char '"' <?> "end of string")
+                      (many stringChar)
+
+stringChar :: Monad m => ParsecT CStream u m (Maybe Char)
+stringChar = (Just <$> stringLetter) <|> escapeCode <?> "string character"
+
+stringLetter :: Monad m => ParsecT CStream u m Char
+stringLetter = satisfy (\c -> ((c /= '"') && (c /= '\\') && (c > '\026')) || c == '\n')
+
+-- escape codes
+escapeCode :: Monad m => ParsecT CStream u m (Maybe Char)                                
+escapeCode = char '\\' *> ((Just <$> try charNum) <|> charEsc) <?> "escape code"
+
+charNum :: Monad m => ParsecT CStream u m Char
+charNum = (toEnum . fromInteger) 
+            <$> ((char '0' *> number 8 octDigit)
+                   <|> (oneOf "xX" *> number 16 hexDigit)
+                   <|> (oneOf "uU" *> number 16 hexDigit))
+    
+charEsc :: Monad m => ParsecT CStream u m (Maybe Char)                                
+charEsc = choice (map (\(c,code) -> char c *> return code) escMap)
+
+escMap          = zip "abfnrtv\\\"\'0\n" (map Just "\a\b\f\n\r\t\v\\\"\'\0" ++ [Nothing])
+
+
+
+ MiniC/PrettyPrint.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, NamedFieldPuns #-}
+
+-- | Adds source templates to a source tree and uses them 
+-- to pretty print it with the original format.
+module MiniC.PrettyPrint where
+
+import SourceCode.SourceTree
+import SourceCode.ToSourceTree
+import MiniC.SourceNotation
+import MiniC.Representation
+import MiniC.RangeTree
+import Data.Maybe
+import Data.List
+import Data.Function
+import Text.Parsec.Pos
+import Text.Parsec.PosOps
+import Control.Lens
+import Control.Monad
+import Control.Applicative
+
+-- | Pretty prints an AST by using source templates stored as node info
+prettyPrint :: (Functor node, ToSourceRose node TemplateInfo) 
+            => node (NodeInfo TemplateInfo si) -> String
+prettyPrint = printRose . toRose . fmap (view sourceInfo)
+      
+-- | Pretty prints a rose tree according to the source templates remainig from the original AST
+printRose :: SourceRose TemplateInfo -> String
+printRose r = printRose' [r]
+  where printRose' :: [SourceRose TemplateInfo] -> String
+        printRose' path = concatMap (printElem path) 
+                            . nodeTemplate 
+                            . roseInfo 
+                            . head 
+                            $ path
+    
+        printElem :: [SourceRose TemplateInfo] -> SourceTemplateElem -> String
+        printElem _ (TextElem str) = str
+        printElem path ni@(NodeElem i) 
+          = case resolveRoseInd i path of Right path -> printRose' path
+                                          -- When only a part of the source tree is printed,
+                                          -- linked nodes can be missing.
+                                          -- Left err -> error ("Error while pretty printing: " 
+                                                               -- ++ err ++ " in " ++ show (head path)
+                                                               -- ++ "\n\ninside\n" ++ show (head (tail path)))
+                                          Left err -> "<???>"
+
+ MiniC/RangeTree.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE NamedFieldPuns #-}
+
+-- | A 2-Dimensional R-Tree for intervals
+module MiniC.RangeTree where 
+
+import Text.Parsec.Pos
+import Text.Parsec.PosOps
+import MiniC.SourceNotation
+import MiniC.Representation
+import SourceCode.SourceTree
+
+import Control.Lens
+import Data.List
+import Data.Maybe
+import Debug.Trace
+
+-- | Trees of ranges in a hierarchical structure, with ranges and indices.
+data RangeTree = RangeTree { rtRange :: SourceRange 
+                           , rtIndex :: RootIndex 
+                           , rtChildren :: [RangeTree]
+                           }
+     deriving (Eq)
+ 
+instance Show RangeTree where
+  show = show' 0
+    where show' i (RangeTree rng ind children) 
+            = "\n" ++ replicate (4*i) '-' ++ shortShowRng rng 
+                ++ " <= " ++ show ind ++ concatMap (show' (i+1)) children
+ 
+-- | Generates a range tree from a source rose. Indexes the tree according to the
+-- hiearchy of nodes in the original tree.
+generateRangeTree :: RootIndex -> SourceRose BasicInfo -> [RangeTree]
+generateRangeTree ri (SourceRose inf original children)
+  = (case (original, inf ^? biRange) of (True, Just rng) -> insertToRangeTree rng ri; _ -> id)
+      $ foldl rangeTreeUnion [] 
+                   (zipWith generateRangeTree (map (flip RootIndex ri) [0..]) children)
+
+-- | A tree of one element
+singletonRT :: SourceRange -> RootIndex -> RangeTree
+singletonRT sr ri = RangeTree sr ri []
+        
+-- Inserts a new node into a range tree
+insertToRangeTree :: SourceRange -> RootIndex -> [RangeTree] -> [RangeTree]
+insertToRangeTree sr ri ranges
+  = let consumedIn = map (\rng -> if sr `rangeInside` rtRange rng 
+                                       && not (ri `rootPrefixOf` rtIndex rng)
+                                     then Just (rng { rtChildren = insertToRangeTree sr ri (rtChildren rng) })
+                                     else Nothing
+                              ) ranges 
+     in case length $ filter isJust consumedIn of
+          1 -> zipWith fromMaybe ranges consumedIn
+          0 -> let (inside, outside) = partition (\rt -> rtRange rt `rangeInside` sr) ranges
+                in (singletonRT sr ri) { rtChildren = inside } : outside
+          _ -> error "insertToRangeTree: invalid RangeTree"
+             
+-- | Creates the union of two range trees
+rangeTreeUnion :: [RangeTree] -> [RangeTree] -> [RangeTree]
+rangeTreeUnion (RangeTree rng ri children : rest) rt2 
+  = rangeTreeUnion rest $ insertToRangeTree rng ri $ rangeTreeUnion children rt2
+rangeTreeUnion [] rt2
+  = rt2 
+  
+-- | Finds indices of nodes in the tree that are inside the given source range and
+-- satisfy the given predicate.
+findContainedWhere :: (SourceRange -> RootIndex -> Bool) -> SourceRange -> [RangeTree] -> [RootIndex]
+findContainedWhere pred sr (RangeTree rng ind _ : more)
+  | rng `rangeInside` sr && pred rng ind
+  = ind : findContainedWhere pred sr more
+findContainedWhere pred sr (tree : more)
+  | rtRange tree `rangeOverlaps` sr
+  = findContainedWhere pred sr (rtChildren tree) ++ findContainedWhere pred sr more
+findContainedWhere pred sr (_ : more)
+  = findContainedWhere pred sr more
+findContainedWhere _ sr [] = []
+        
+
+ MiniC/Representation.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, NamedFieldPuns, DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving, TemplateHaskell, ImpredicativeTypes, UndecidableInstances #-}
+
+-- | Extends 'MiniC.AST' with node information types, and class instances for AST nodes.
+module MiniC.Representation where
+
+import GHC.Generics (Generic)
+import SourceCode.ASTElems
+import MiniC.AST
+import MiniC.SourceNotation
+import SourceCode.SourceTree
+import SourceCode.ToSourceTree
+import SourceCode.ASTNode
+import SourceCode.SourceInfo
+import Data.Typeable
+import Data.Data
+import Data.List
+import Data.Maybe
+import Data.Function
+import Text.Parsec hiding ((<|>), optional, many)
+import Text.Parsec.PosOps
+import Data.Data.Lens
+import Control.Lens
+import Control.Applicative
+import Debug.Trace
+
+-- | Syntactic and semantic information about an AST node
+data NodeInfo src sem
+  = NodeInfo { _sourceInfo :: src
+             , _semanticInfo :: sem
+             }      
+    deriving (Show, Typeable, Data)             
+
+makeLenses ''NodeInfo
+    
+-- All source info is considered equal, so in a container all AST nodes 
+-- with the same structure are not differentiated.
+instance Eq (NodeInfo source sema) where
+  _ == _ = True 
+instance Ord (NodeInfo source sema) where
+  _ `compare` _ = EQ
+    
+-- | An intermediate node information that contains the source range 
+-- of the node and the remaining input of the parser when it started 
+-- parsing the element. We could only store the text from which the node
+-- was parsed, but then we could not extend nodes from their children.
+data BasicInfo -- ^ The node was originally in the source 
+  = BasicInfo { _biRange :: SourceRange
+              , _biInput :: String
+              }
+  | InheritInfo
+  deriving (Eq, Ord, Typeable, Data)
+  
+$(makeLenses ''BasicInfo)
+  
+instance SourceInfo BasicInfo where
+  generateInfo ancestor []
+    = ancestor & biRange %~ rngStartAsRange
+  generateInfo _ children
+    = foldl1 unifyBasicInfo children
+  noNodeInfo = InheritInfo
+  
+deriving instance Typeable SourceTemplateElem
+deriving instance Data SourceTemplateElem
+deriving instance Typeable NodeIndex
+deriving instance Data NodeIndex
+
+-- | Gets the range of a basic info
+getRange :: BasicInfo -> Maybe SourceRange
+getRange = preview biRange
+
+-- | Combines two basic infos into one
+unifyBasicInfo :: BasicInfo -> BasicInfo -> BasicInfo
+unifyBasicInfo (BasicInfo rng1 inp1) (BasicInfo rng2 inp2) 
+  = BasicInfo (rng1 `srcRngUnion` rng2) 
+              (if srcRangeBegin rng1 < srcRangeBegin rng2 then inp1 else inp2)
+unifyBasicInfo bi InheritInfo = bi
+unifyBasicInfo InheritInfo bi = bi
+
+instance Show BasicInfo where
+  show (BasicInfo rng inp) 
+    = shortShowRng rng ++ " '" ++ takeSourceRange (rngFromStart rng) inp ++ "'"
+  show InheritInfo = "<inherited>"
+      
+-- | The final meta information that can be used to pretty print the AST
+data TemplateInfo 
+  = TemplateInfo 
+      { _niRange     :: Maybe SourceRange
+      , _niTemplate  :: Maybe SourceTemplate 
+      }
+      -- [Comment]    -- ^ comments belonging
+      -- [Attribute]  -- ^ attributes
+         deriving (Eq, Ord, Typeable, Data)
+  
+$(makeLenses ''TemplateInfo)
+
+  
+instance SourceInfo TemplateInfo where
+  generateInfo ancestor [] 
+    = TemplateInfo (rngStartAsRange <$> view niRange ancestor) (Just [])
+  generateInfo _ infs
+    = TemplateInfo (foldl1 (\a b -> srcRngUnion <$> a <*> b) (infs ^.. traverse.niRange)) 
+                   (Just (map (\i -> NodeElem (NthChildOf i Current)) 
+                              (take (length infs) [0..])))
+  noNodeInfo = TemplateInfo Nothing Nothing
+  
+instance Show TemplateInfo where
+  show (TemplateInfo rng templ) = maybe "" shortShowRng rng ++ "||" ++ maybe "" (concatMap show) templ ++ "||"
+      
+nodeTemplate :: TemplateInfo -> SourceTemplate
+nodeTemplate (TemplateInfo { _niTemplate = Just t }) = t
+  
+-- * Preprocessor-handled source elements
+  
+data Comment = LineComment String
+             | BlockComment String
+             | DocComment String
+             
+data AttributeList a 
+  = AttributeList { attributes    :: [Attribute a]
+                  , attributeInfo :: a
+                  } deriving (Show, Eq)
+    
+data Attribute a
+  = Alias        { attribAlias          :: String
+                 , attribInfo           :: a 
+                 }                      
+  | Aligned      { attribAlign          :: Int
+                 , attribInfo           :: a
+                 }                      
+  | AllocSize    { attribAllocSizeArgs  :: [Int]
+                 , attribInfo           :: a
+                 }                      
+  | AlwaysInline { attribInfo           :: a }
+  | CDecl        { attribInfo           :: a }
+  | Const        { attribInfo           :: a }
+  | Constructor  { attribInfo           :: a }
+  | Destructor   { attribInfo           :: a }
+  | Deprecated   { attribInfo           :: a }
+  | Format       { attribFormatFunct    :: String
+                 , attribFormatStrArg   :: Int 
+                 , attribFormatCheckArg :: Int 
+                 , attribInfo           :: a 
+                 }
+  | Malloc       { attribInfo           :: a }
+  | Mode         { attribMode           :: ModeSpec 
+                 , attribInfo           :: a
+                 }
+  | NoInline     { attribInfo           :: a }
+  | NoReturn     { attribInfo           :: a }
+  | Optimize     { attribOptArgs        :: [Either String Int]
+                 , attribInfo           :: a 
+                 }
+  | Packed       { attribInfo           :: a }
+  | Pure         { attribInfo           :: a }
+  | RegParam     { attribRegNum         :: Int
+                 , attribInfo           :: a 
+                 }
+  | Section      { attribSection        :: String
+                 , attribInfo           :: a 
+                 }
+  | StdCall      { attribInfo           :: a }
+  | TransparentUnion { attribInfo           :: a }
+  | Unused       { attribInfo           :: a }
+  | Used         { attribInfo           :: a }
+  | Visibility   { attribVisibility     :: VisibilityMode
+                 , attribInfo           :: a 
+                 }
+  | Weak         { attribInfo           :: a }
+  deriving (Show, Eq)
+                 
+data ModeSpec = ByteMode | WordMode | PointerMode
+     deriving (Show, Eq)
+data VisibilityMode = DefaultVisibility | HiddenVisibility | InternalVisibility | ProtectedVisibility
+     deriving (Show, Eq)
+  
+  
+
+
+ MiniC/Semantics.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE NoMonomorphismRestriction, LambdaCase, DeriveDataTypeable, DeriveFunctor, TemplateHaskell
+           , TypeSynonymInstances, FlexibleInstances #-}
+module MiniC.Semantics where
+
+import MiniC.AST
+import MiniC.Representation
+import MiniC.PrettyPrint
+
+import Control.Applicative
+import Control.Lens
+import Control.Lens.Plated
+import Data.Data.Lens
+import Data.Data
+import Data.Monoid
+import Data.Function
+import Data.Maybe
+import Data.Typeable
+import SourceCode.SourceInfo
+import SourceCode.ToSourceTree
+  
+
+type BI = NodeInfo BasicInfo SemaInfo
+type NI = NodeInfo TemplateInfo SemaInfo
+  
+data SemaInfo 
+  = SemaInfo { _declQualName :: Maybe QualifiedName
+             , _referenceQualName :: Maybe QualifiedName
+             , _exprType :: Maybe SemType
+             }
+    deriving (Eq, Ord, Typeable, Data)  
+  
+data SemType 
+  = Int Sign IntSize 
+  | Float FloatingSize
+  -- ...
+  deriving (Show, Eq, Ord, Typeable, Data) 
+               
+  -- | A C name with the scope of the name        
+data QualifiedName
+  = QualifiedName { _qnNameSpace :: NameSpace
+                  , _qnScope :: Scope
+                  , _qnTypeQual :: TypeQualifier NI
+                  }
+  deriving (Eq, Ord, Typeable, Data)
+
+data NameSpace = NormalNS  -- ^ Namespace for variables, functions, 
+                           -- typedef-ed names, enum variants
+               | ComplexNS -- ^ Namespace for structs, unions and enums
+  deriving (Eq, Ord, Typeable, Data)  
+  
+newtype Scope = Scope { _scopeNames :: [String] }
+  deriving (Eq, Ord, Typeable, Data) 
+      
+instance Show NameSpace where
+  show NormalNS = ""
+  show ComplexNS = "$"
+ 
+emptyScope :: Scope
+emptyScope = Scope []
+  
+$(makeLenses ''Scope)
+$(makeLenses ''QualifiedName)
+
+instance Show Scope where
+  show (Scope sc) = foldr (\b a -> a ++ "::" ++ b) "" sc
+  
+type Fun a = a -> a
+
+simplifyQualName :: QualifiedName -> QualifiedName
+simplifyQualName 
+  = qnScope.scopeNames %~ filter (null . (id :: Fun [(Int,String)]) . reads)
+
+outerScope :: QualifiedName -> Maybe QualifiedName
+outerScope qn 
+  = if null (qn ^. qnScope.scopeNames) 
+      then Nothing 
+      else Just $ qn & qnScope.scopeNames %~ tail
+      
+$(makeLenses ''SemaInfo)   
+  
+instance SourceInfo srci => SourceInfo (NodeInfo srci SemaInfo) where
+  generateInfo anc children 
+    = NodeInfo (generateInfo (anc ^. sourceInfo) (children ^.. each.sourceInfo)) emptySemaInfo
+  noNodeInfo = NodeInfo noNodeInfo emptySemaInfo
+  
+emptySemaInfo :: SemaInfo
+emptySemaInfo 
+  = SemaInfo Nothing Nothing Nothing
+
+ MiniC/SourceNotation.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TypeOperators, FlexibleInstances, FlexibleContexts, DefaultSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses, OverlappingInstances, LambdaCase #-}
+
+-- | A module for representing how to print the AST in the original format
+module MiniC.SourceNotation where
+
+import SourceCode.ASTNode
+import SourceCode.SourceTree
+
+import GHC.Generics
+import Control.Applicative
+import Data.Maybe
+import Data.Either
+import Data.List
+import Data.Function
+import Debug.Trace
+import Text.Parsec.PosOps
+    
+-- | A pattern that controls how the original source code can be
+-- retrieved from the AST. A source template is assigned to each node.
+-- It has holes where the content of an other node should be printed.
+type SourceTemplate = [SourceTemplateElem]   
+ 
+data SourceTemplateElem = TextElem String 
+                        | NodeElem NodeIndex
+     deriving (Eq, Ord)
+     
+isTextElem :: SourceTemplateElem -> Bool
+isTextElem (TextElem _) = True
+isTextElem _ = False
+
+isNodeElem :: SourceTemplateElem -> Bool
+isNodeElem (NodeElem _) = True
+isNodeElem _ = False
+      
+instance Show SourceTemplateElem where
+  show (TextElem s) = s
+  show (NodeElem ni) = "<" ++ show ni ++ ">"
+     
+getIndexedNode :: SourceTemplateElem -> Maybe NodeIndex
+getIndexedNode (NodeElem ni) = Just ni
+getIndexedNode _ = Nothing
+     
+steCombine :: SourceTemplateElem -> SourceTemplateElem -> SourceTemplateElem
+steCombine (TextElem s1) (TextElem s2) = TextElem (s1 ++ s2)
+steCombine (TextElem "") e = e
+steCombine e (TextElem "") = e
+steCombine e1 e2 = error $ "Source template elements " 
+                             ++ show e1 ++ " and " ++ show e2 
+                             ++ " cannot be combined."
+
+-- | Creates a template from a source range and an input string by cutting out each given node
+createTemplate :: [(SourceRange, NodeIndex)] -> SourceRange -> String -> SourceTemplate
+createTemplate toCutOut sr input
+  = let source = takeSourceRange (rngFromStart sr) input
+        sortedNodes = sortBy (flip compare `on` fst) toCutOut
+     in foldl (cutOutNode sr) [TextElem source] sortedNodes
+  where -- | Must be applied to the last child to cut out, so the prefix remains an intacts string
+        cutOutNode :: SourceRange -> SourceTemplate -> (SourceRange, NodeIndex) -> SourceTemplate
+        cutOutNode sr (TextElem txt : rest) (cutOutSr, index) = 
+            let cutOutRng = cutOutSr `rangeRelativelyTo` srcRangeBegin sr
+                textBefore = snd $ takeToPos' (srcRangeBegin cutOutRng) txt
+                textAfter = snd $ dropToPos' (srcRangeEnd cutOutRng) txt 
+             in TextElem textBefore : NodeElem index : TextElem textAfter : rest
+
+
+ MiniC/SymbolTable.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TupleSections #-}
+
+-- | This module controls how symbols are represented in the symbol table. This module
+-- holds the definitions relating to symbol tables that are pure (non-monadic). Monadic
+-- operations are defined in 'MiniC.Parser.Base'.
+module MiniC.SymbolTable where
+
+import MiniC.AST
+import MiniC.Helpers
+import MiniC.Semantics
+import qualified Data.Map as M
+import Data.Data
+import Control.Applicative
+import Control.Lens
+   
+
+newtype SymbolTable ni 
+  = SymbolTable { _symbolMap :: M.Map QualifiedName (SymbolEntry ni) }
+
+data SymbolEntry ni
+  = VariableEntry { _varEntryStorage :: [StorageSpecifier ni]
+                  , _varEntryQualTyp :: QualifiedType ni
+                  , _varEntryAsmSpec :: Maybe (AsmSpecifier ni)
+                  , _varEntryInit :: Maybe (Expression ni)
+                  , _varEntryInfo :: ni
+                  }
+  | ParameterEntry { _parEntryDecl :: ParameterDeclaration ni }
+  | FunctionEntry { _funEntryDecl :: FunctionDeclaration ni }
+  | TypeEntry { _typeEntryDecl :: TypeDefinition ni }
+  | VariantEntry { _variantEntryDecl :: Variant ni }
+  deriving (Show)
+  
+data CUserState ni = CUserState 
+  { _symbolTable :: SymbolTable ni
+  , _currentScope :: Scope
+  , _currentIds :: [Int]
+  }
+
+initUserState :: CUserState ni
+initUserState = CUserState (SymbolTable M.empty) emptyScope [0]
+
+$(makeLenses ''SymbolTable)
+$(makeLenses ''CUserState)
+$(makeLenses ''SymbolEntry)
+
+lookupSymbol :: QualifiedName -> SymbolTable ni -> Maybe (QualifiedName, SymbolEntry ni)
+lookupSymbol qn st
+  = ((qn, ) <$> M.lookup qn (view symbolMap st)) 
+      <|> (outerScope qn >>= flip lookupSymbol st)
+ MiniC/TransformInfo.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE LambdaCase, ScopedTypeVariables, FlexibleContexts, MultiParamTypeClasses #-}
+
+-- | The purpose of this module is to transform an AST with basic infos to an AST with templates.
+module MiniC.TransformInfo where
+
+import MiniC.Representation
+import MiniC.SourceNotation
+import MiniC.RangeTree
+import MiniC.Semantics
+import Control.Lens
+import Control.Monad.State
+import Control.Monad.Reader
+import Data.SmartTrav.Class
+import Data.Maybe
+import Text.Parsec.PosOps
+import SourceCode.SourceTree
+import SourceCode.ToSourceTree
+import Debug.Trace
+
+        
+-- | Creates source templates from simple source strings
+transformSourceInfo :: (SmartTrav node, ToSourceRose node BI)
+                    => node BI -> node NI
+transformSourceInfo = cutOutTemplates . expandNodes
+
+-- | Expands nodes to contain all their children
+expandNodes :: SmartTrav node => node BI -> node BI
+expandNodes n = evalState (expandNodes' n) [Nothing]
+  where expandNodes' :: SmartTrav node => node BI -> State [Maybe BI] (node BI)
+        expandNodes' = smartTrav desc asc f
+        
+        desc = modify (Nothing:)
+        asc  = modify (\case (x : y : xs) -- if both exist union, otherwise keep existing
+                                          -> maybe y (\x' -> maybe x (Just . (sourceInfo %~ unifyBasicInfo (x' ^. sourceInfo))) y) x : xs)
+        f inf 
+          = do ni <- gets head
+               let newInfo = maybe inf (\ni -> inf & sourceInfo %~ unifyBasicInfo (ni ^. sourceInfo)) ni
+               modify (\case (_ : xs) -> Just newInfo : xs)
+               return newInfo
+
+-- | Replaces assigned input of nodes with source templates.
+-- Goes top-down and replaces the info in every node according to structure of the whole tree.
+cutOutTemplates :: forall node . (SmartTrav node, ToSourceRose node BI) 
+                => node BI -> node NI
+cutOutTemplates ast 
+  = let rose = fmap (view sourceInfo) (toRose ast)
+     in evalState (runReaderT (cutOutTemplates' ast)
+                              (rose, generateRangeTree Root rose))
+                  (Root,0)                 
+
+  where cutOutTemplates' :: node BI -> ReaderT (SourceRose BasicInfo, [RangeTree]) 
+                                                      (State (RootIndex, Int)) 
+                                                      (node NI)
+        cutOutTemplates' 
+          = do smartTrav ( lift $ modify (\(ri, i) -> (RootIndex i ri, 0)) )
+                         ( lift $ modify (\(RootIndex i ri, _) -> (ri, i+1)) )
+                         createTempInf
+        createTempInf bi 
+          = do (tree, rngTree) <- ask
+               currInd <- gets fst
+               let rng = bi ^?! sourceInfo.biRange
+                   inp = bi ^?! sourceInfo.biInput
+                   relativeIndAndRng ind = (info,rel)
+                     where info = fromMaybe (error "No range for a node that is to be cut out")
+                                    . getRange 
+                                    . roseInfo 
+                                    $ resolveRootInd ind tree
+                           rel = ind `indRelativelyTo` currInd 
+                   contained = findContainedWhere 
+                                 (\rng ind -> not (emptyRange rng) 
+                                                && not (ind `rootPrefixOf` currInd)) 
+                                 rng rngTree
+                   toRemove = map relativeIndAndRng contained 
+               return $ bi & sourceInfo .~ TemplateInfo (Just rng) 
+                                                        (Just $ createTemplate toRemove rng inp)
+ RemixC.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE LambdaCase, ViewPatterns, FlexibleContexts #-}
+
+module RemixC where
+
+import CTransform
+import Text.Parsec
+import qualified Text.Parsec.Token as T
+import qualified Text.Parsec.Language as L
+import Test.HUnit hiding (test)
+import Control.Lens
+import Control.Applicative hiding ((<|>),many)
+import Data.Maybe
+import System.Directory
+import System.FilePath
+import qualified MiniC
+import MiniC.ParseProgram
+import MiniC.Parser
+import MiniC.Parser.Base
+import MiniC.Parser.Lexical
+import MiniC.PrettyPrint
+import MiniC.TransformInfo
+import Debug.Trace
+
+test = tests >>= runTestTT . TestList
+
+tests = do trfTests <- testOracles 
+           miniC_tests <- MiniC.tests
+           return [ TestLabel "MiniC.tests" miniC_tests
+                  , TestLabel "trfTests" trfTests
+                  ]
+          
+
+testOracles :: IO Test
+testOracles
+  = do wd <- getCurrentDirectory 
+       testfiles <- getDirectoryContents (wd </> "testfiles\\ok")
+       let tests = map (\fn -> wd </> "testfiles\\ok" </> fn)
+                     . filter (\fn -> takeExtensions fn `elem` [".c",".cpp",".h"])
+                     $ testfiles
+       TestList . catMaybes 
+         <$> mapM fileTest tests
+       
+  where fileTest :: FilePath -> IO (Maybe Test)
+        fileTest file 
+          = readFile file
+              >>= parseTestFile 
+              >>= \case
+                (Right (Just param, expected)) -> 
+                  do runProgram (param & inputFile %~ (dropFileName file </>)) >>= \case
+                       Right result -> mkTest file $ assertTrfEqual param (transformSourceInfo expected) result 
+                       Left err -> mkTest file $ assertFailure (show err)
+                Right _ -> return Nothing
+                Left err -> mkTest file $ assertFailure (show err)
+        mkTest file = return . Just . TestLabel file . TestCase
+        assertTrfEqual param expected result 
+          = assertEqual ("TRANSFORMING " ++ show param ++ "\n\nSHOULD RESULT IN\n\n" 
+                           ++ prettyPrint expected  ++ "\n\nRATHER THAN\n\n" 
+                           ++ prettyPrint result) 
+                        (fmap (const ()) expected) (fmap (const ()) result)
+          -- = assertBool ("TRANSFORMING " ++ show param ++ "\n\nSHOULD RESULT IN\n\n" 
+                           -- ++ prettyPrint expected ++ "\n\nRATHER THAN\n\n" 
+                           -- ++ prettyPrint result) 
+                        -- (expected == result)
+       
+       
+parseTestFile = parseWithPreproc ((,) <$> commentParser <*> whole translationUnit) "<test comment>"
+      
+commentParser :: CParser (Maybe ProgramParams)
+commentParser 
+  = optionMaybe $
+      try (symbol "//") *> symbol "RESULT" *> symbol "OF" *> symbol "`" *> symbol "remix" 
+        *> (ProgramParams
+             <$> lexeme (many1 (alphaNum <|> oneOf "/\\_-.,"))
+             <*> many ( try (symbol "-ii") *> (IntroduceIndirection <$> qualifiedName)
+                          <|> try (symbol "-ri") *> (RemoveIndirection <$> qualifiedName)
+                          <|> try (symbol "-cc") *> pure CreateSkeleton ))
+        <* symbol "`"
+
+configAll 
+  = do wd <- getCurrentDirectory 
+       testfiles <- getDirectoryContents (wd </> "testfiles\\ok") 
+       let tests = map (\fn -> wd </> "testfiles\\ok" </> fn)
+                     . filter (\fn -> takeExtensions fn `elem` [".c",".cpp",".h"])
+                     $ testfiles
+       mapM_ (runProgram . flip ProgramParams [CreateSkeleton]) tests
+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ SourceCode/ASTElems.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE StandaloneDeriving, DeriveFunctor, DeriveGeneric, DeriveDataTypeable, LambdaCase
+           , MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, KindSignatures
+           , UndecidableInstances, TemplateHaskell #-}
+
+-- | Commonly used AST elements. They abstract the type of additional node information,
+-- so it is easier to define instances on them.
+module SourceCode.ASTElems where
+
+import SourceCode.ASTNode
+
+-- TODO: add isos for pairs, triples and lists to a pair of a tuple or list and an info
+-- TODO: add infos to pairs and triples
+-- TODO: _1, _2, _3 lenses for pairs and triples, ix lens for lists, 
+--       _left and _right traversals for ASTEither, _just traversal for ASTMaybe
+-- TODO: ASTNode instances for all
+
+import Data.Data
+import Data.Typeable
+import GHC.Generics
+import Control.Lens
+    
+-- | An AST node that wraps another node. This can be used to capture additional input.
+data ASTWrapper (n :: * -> *) a
+  = ASTWrapper  { _astWrapped :: n a
+                , _astWrappedInfo :: a 
+                }
+
+makeLenses ''ASTWrapper
+    
+deriving instance (Show a, Show (n a)) => Show (ASTWrapper n a)
+deriving instance (Eq a, Eq (n a)) => Eq (ASTWrapper n a)
+deriving instance (Ord a, Ord (n a)) => Ord (ASTWrapper n a)
+deriving instance (Functor n) => Functor (ASTWrapper n)
+deriving instance (Generic (n a)) => Generic (ASTWrapper n a)    
+deriving instance Typeable ASTWrapper
+deriving instance (Data a, Data (e a), Typeable e) => Data (ASTWrapper e a)   
+ 
+-- | An AST node that is optional
+data ASTMaybe (n :: * -> *) a
+  = ASTJust  { _astJust      :: n a }
+  | ASTNothing
+
+makeLenses ''ASTMaybe
+  
+astMaybe :: Iso' (ASTMaybe n a) (Maybe (n a))
+astMaybe = iso (\case (ASTJust a) -> Just a; ASTNothing -> Nothing)
+               (\case (Just a) -> ASTJust a; Nothing -> ASTNothing)
+    
+deriving instance (Show a, Show (n a)) => Show (ASTMaybe n a)
+deriving instance (Eq a, Eq (n a)) => Eq (ASTMaybe n a)
+deriving instance (Ord a, Ord (n a)) => Ord (ASTMaybe n a)
+deriving instance (Functor n) => Functor (ASTMaybe n)
+deriving instance (Generic (n a)) => Generic (ASTMaybe n a)    
+deriving instance Typeable ASTMaybe
+deriving instance (Data a, Data (e a), Typeable e) => Data (ASTMaybe e a)
+
+-- | One of the two node types. For example either a declaration or a statement 
+-- in languages that the two can be mixed. This is preferred over defining a 
+-- new node 'DeclarationOrStatement'.
+data ASTEither (n :: * -> *) (m :: * -> *) a
+  = ASTLeft  { _astLeft      :: n a }
+  | ASTRight { _astRight     :: m a }
+  
+makeLenses ''ASTEither
+  
+astEither :: Iso' (ASTEither n m a) (Either (n a) (m a))
+astEither = iso (\case ASTLeft a -> Left a; ASTRight a -> Right a)
+                (\case Left a -> ASTLeft a; Right a -> ASTRight a)
+  
+deriving instance (Show a, Show (n a), Show (m a)) => Show (ASTEither n m a)
+deriving instance (Eq a, Eq (n a), Eq (m a)) => Eq (ASTEither n m a)
+deriving instance (Ord a, Ord (n a), Ord (m a)) => Ord (ASTEither n m a)
+deriving instance (Functor n, Functor m) => Functor (ASTEither n m)
+deriving instance (Generic (n a), Generic (m a)) => Generic (ASTEither n m a)
+deriving instance Typeable ASTEither
+deriving instance (Data a, Data (n a), Data (m a), Typeable n, Typeable m) => Data (ASTEither n m a)
+
+-- | Two AST nodes linked together.
+data ASTPair (n :: * -> *) (m :: * -> *) a
+  = ASTPair  { _astFirst      :: n a
+             , _astSecond     :: m a 
+             }
+             
+makeLenses ''ASTPair
+             
+astGetPair :: ASTPair n m a -> (n a, m a)
+astGetPair (ASTPair fst snd) = (fst, snd)
+  
+deriving instance (Show a, Show (n a), Show (m a)) => Show (ASTPair n m a)
+deriving instance (Eq a, Eq (n a), Eq (m a)) => Eq (ASTPair n m a)
+deriving instance (Ord a, Ord (n a), Ord (m a)) => Ord (ASTPair n m a)
+deriving instance (Functor n, Functor m) => Functor (ASTPair n m)
+deriving instance (Generic (n a), Generic (m a)) => Generic (ASTPair n m a)
+deriving instance Typeable ASTPair
+deriving instance (Data a, Data (n a), Data (m a), Typeable n, Typeable m) => Data (ASTPair n m a)
+    
+-- | Three AST nodes linked together.
+data ASTTriple (n :: * -> *) (m :: * -> *) (p :: * -> *) a
+  = ASTTriple { _ast_triple_1       :: n a
+              , _ast_triple_2       :: m a 
+              , _ast_triple_3       :: p a 
+              , _ast_triple_info    :: a
+              }
+             
+makeLenses ''ASTTriple
+             
+astGetTriple :: ASTTriple n m p a -> (n a, m a, p a)
+astGetTriple (ASTTriple fst snd thrd _) = (fst, snd, thrd)
+  
+deriving instance (Show a, Show (n a), Show (m a), Show (p a)) => Show (ASTTriple n m p a)
+deriving instance (Eq a, Eq (n a), Eq (m a), Eq (p a)) => Eq (ASTTriple n m p a)
+deriving instance (Ord a, Ord (n a), Ord (m a), Ord (p a)) => Ord (ASTTriple n m p a)
+deriving instance (Functor n, Functor m, Functor p) => Functor (ASTTriple n m p)
+deriving instance (Generic (n a), Generic (m a), Generic (p a)) => Generic (ASTTriple n m p a)
+deriving instance Typeable ASTTriple
+deriving instance (Data a, Data (n a), Data (m a), Data (p a), Typeable n, Typeable m, Typeable p) => Data (ASTTriple n m p a)
+instance (Generic (n a), Generic (m a), Generic (p a), ASTNode n a, ASTNode m a, ASTNode p a) => ASTNode (ASTTriple n m p) a where
+    
+-- | A list of AST elements.
+data ASTList e a 
+  = ASTCons { _listHead      :: e a
+            , _listTail      :: ASTList e a 
+            , _listInfo      :: a 
+            }
+  | ASTNil
+            
+makeLenses ''ASTList
+            
+astGetList :: ASTList e a -> [e a]
+astGetList (ASTCons listHead listTail _) = listHead : astGetList listTail
+astGetList (ASTNil) = []
+            
+deriving instance (Show a, Show (e a)) => Show (ASTList e a)
+deriving instance (Eq a, Eq (e a)) => Eq (ASTList e a)
+deriving instance (Ord a, Ord (e a)) => Ord (ASTList e a)
+deriving instance Functor e => Functor (ASTList e)
+deriving instance Generic (e a) => Generic (ASTList e a)
+deriving instance Typeable ASTList
+deriving instance (Data a, Data (e a), Typeable e) => Data (ASTList e a)
+
+type ASTParenList e = ASTWrapper (ASTList e)
+
+ SourceCode/ASTNode.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE MultiParamTypeClasses, TypeOperators, FlexibleInstances, FlexibleContexts, DefaultSignatures, OverlappingInstances, ImpredicativeTypes #-}
+
+-- | Provides a derivable class that can be used to access information stored in nodes.
+module SourceCode.ASTNode where
+
+import Control.Lens (Lens', lens)
+import GHC.Generics
+import Control.Applicative
+import Data.Maybe
+
+-- | Mark data in the AST that is not a node itself
+-- No data type should ever be instantiated with both 'ASTData' and 'ASTNode' classes.
+class ASTData d where
+
+-- | Mark a datatype that it is an AST node. Provides access to the node information.
+-- TODO : replace with a SmartTrav traversal
+class ASTNode a inf where
+  info :: Lens' (a inf) inf
+  info = lens getInfo (flip setInfo)
+
+  getInfo :: a inf -> inf
+  
+  default getInfo :: (Generic (a inf), GASTNode (Rep (a inf)) inf)
+                  => a inf -> inf
+  getInfo = fromMaybe (error "getInfo: No info for node") . ggetInfo True . from
+  
+  setInfo :: inf -> a inf -> a inf
+  default setInfo :: (Generic (a inf), GASTNode (Rep (a inf)) inf)
+                  => inf -> a inf -> a inf
+  setInfo inf = to . gsetInfo True inf . from
+  
+-- | Generic class to access info members inside nodes
+class GASTNode f inf where
+  ggetInfo :: Bool -> f a -> Maybe inf
+  ggetInfo _ _ = Nothing
+  
+  gsetInfo :: Bool -> inf -> f a -> f a
+  gsetInfo _ _ k = k
+  
+-- | No info in empty constructors
+instance GASTNode U1 inf where
+  
+-- | Ignore metainformation
+instance (GASTNode a inf) => GASTNode (M1 t c a) inf where
+  ggetInfo k (M1 x) = ggetInfo k x
+  gsetInfo k inf m1@(M1 x) = M1 $ gsetInfo k inf x
+  
+-- | Add the results from parts of products, 
+-- but can only follow a member if there is only one
+instance (GASTNode a inf, GASTNode b inf) 
+           => GASTNode (a :*: b) inf where
+  ggetInfo _ (a :*: b) = ggetInfo False a <|> ggetInfo False b
+  gsetInfo _ inf (a :*: b) = gsetInfo False inf a :*: gsetInfo False inf b
+  
+-- | Ignore other possiblities
+instance (GASTNode a inf, GASTNode b inf) 
+           => GASTNode (a :+: b) inf where
+  ggetInfo k (L1 x) = ggetInfo k x
+  ggetInfo k (R1 x) = ggetInfo k x
+  gsetInfo k inf (L1 x) = L1 $ gsetInfo k inf x
+  gsetInfo k inf (R1 x) = R1 $ gsetInfo k inf x
+  
+-- | When a field is the info return / replace it
+instance GASTNode (K1 i inf) inf where
+  ggetInfo _ (K1 x) = Just x
+  gsetInfo _ inf (K1 x) = K1 inf
+  
+-- | On data nodes inside AST, return Nothing / leave it be
+instance ASTData a => GASTNode (K1 i a) inf where
+  
+-- | On children nodes, if there is only one child try to return the info
+-- from there or replace there. This helps to keep AST from containing 
+-- redundant info data.
+instance ASTNode a inf => GASTNode (K1 i (a inf)) inf where      
+  ggetInfo True (K1 x) = Just $ getInfo x
+  ggetInfo False _ = Nothing
+  
+  gsetInfo True inf (K1 x) = K1 $ setInfo inf x
+  gsetInfo False inf constr = constr
+ SourceCode/Parsec.hs view
@@ -0,0 +1,14 @@+module SourceCode.Parsec where
+
+import Text.Parsec
+import Control.Applicative hiding ((<|>), many, optional)
+
+import SourceCode.ASTElems
+
+astParseEither :: ParsecT s u m (a i) -> ParsecT s u m (b i) 
+               -> ParsecT s u m (ASTEither a b i)
+astParseEither p1 p2 
+  = (ASTLeft <$> p1) <|> (ASTRight <$> p2)
+  
+
+
+ SourceCode/SourceInfo.hs view
@@ -0,0 +1,13 @@+module SourceCode.SourceInfo where
+
+-- | Source information for an AST
+class SourceInfo a where
+
+  -- | Generates an information for a node from the information of the closest ancestor
+  --  node with it's own info, and the information of it's children.
+  generateInfo :: a -> [a] -> a
+  
+  -- | Generates a node with no info
+  noNodeInfo :: a
+  
+
+ SourceCode/SourceTree.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE LambdaCase, NamedFieldPuns, DeriveFunctor, DeriveDataTypeable #-}
+
+-- | A simpler representation of the original AST. Enables easy relative indexing of the nodes.
+module SourceCode.SourceTree where
+
+import Data.Maybe
+import Data.Data
+
+-- | Relative indexing of nodes in a 'SourceRose' tree
+data NodeIndex = Current 
+               | ParentOf NodeIndex 
+               | NthChildOf Int NodeIndex
+     deriving (Eq, Ord)
+          
+instance Show NodeIndex where
+  show Current = "."
+  show (ParentOf ni) = show ni ++ "/.."
+  show (NthChildOf i ni) = show ni ++ "/" ++ show i
+   
+-- | Evaluates a node indexing, from the path to current elem generates the path to the indexed elem
+resolveRoseInd :: Show a => NodeIndex -> [SourceRose a] -> Either String [SourceRose a]
+resolveRoseInd Current path = Right path
+resolveRoseInd (ParentOf i) path 
+  = resolveRoseInd i path >>= \case (_:par) -> Right par
+                                    [] -> Left "empty path"
+resolveRoseInd (NthChildOf n i) path
+  = resolveRoseInd i path >>= 
+      \case (path@(SourceRose {roseChildren} : _)) -> 
+              if n >= 0 && n < length roseChildren 
+                then Right ((roseChildren !! n) : path) 
+                else Left $ "no " ++ show n ++ "th child"
+            [] -> Left "empty path"
+   
+-- | Modifies a root index by a relative one
+addRelPath :: RootIndex -> NodeIndex -> RootIndex
+addRelPath ind Current = ind
+addRelPath ind1 (ParentOf ind2) 
+  = case ind1 `addRelPath` ind2 of RootIndex _ ind -> ind
+                                   _ -> error "No parent"
+addRelPath ind1 (NthChildOf i2 ind2) 
+  = RootIndex i2 (ind1 `addRelPath` ind2)
+
+-- | Concatenates two relative indexes
+addPath :: NodeIndex -> NodeIndex -> NodeIndex
+ind `addPath` Current = ind
+ind `addPath` (ParentOf ni) = ParentOf (ind `addPath` ni)
+ind `addPath` (NthChildOf i ni) = NthChildOf i (ind `addPath` ni)
+   
+-- | Indexing of nodes in a 'SourceRose' tree from root
+data RootIndex = Root | RootIndex Int RootIndex
+     deriving (Eq)
+     
+instance Show RootIndex where
+  show Root = ""
+  show (RootIndex i ni) = show ni ++ "/" ++ show i
+
+rootPrefixOf :: RootIndex -> RootIndex -> Bool
+Root `rootPrefixOf` Root = True
+(RootIndex i1 ind1) `rootPrefixOf` (RootIndex i2 ind2) | i1 == i2 
+  = ind1 `rootPrefixOf` ind2
+ind1 `rootPrefixOf` (RootIndex _ ind2)
+  = ind1 `rootPrefixOf` ind2
+_ `rootPrefixOf` _
+  = False
+     
+resolveRootInd :: RootIndex -> SourceRose a -> SourceRose a
+resolveRootInd (RootIndex i ind) tree 
+  = let SourceRose {roseChildren} = resolveRootInd ind tree
+     in roseChildren !! i
+resolveRootInd Root tree = tree
+
+pathToRoot :: RootIndex -> NodeIndex
+pathToRoot (RootIndex _ ind) = ParentOf (pathToRoot ind)
+pathToRoot Root = Current
+
+pathFromRoot :: RootIndex -> NodeIndex
+pathFromRoot (RootIndex i ind) = NthChildOf i (pathFromRoot ind)
+pathFromRoot Root = Current
+     
+depth :: RootIndex -> Int
+depth Root = 0
+depth (RootIndex _ ind) = depth ind + 1
+     
+indRelativelyTo :: RootIndex -> RootIndex -> NodeIndex
+indRelativelyTo r1 r2 = indRel r1 r2 Current
+  where indRel r1 r2 p
+          | r1 == r2
+          = p
+        indRel r1 r2@(RootIndex i2 ind2) p
+          | depth r1 < depth r2 
+          = indRel r1 ind2 (ParentOf p)
+        indRel (RootIndex i1 ind1) r2 p
+          = NthChildOf i1 (indRel ind1 r2 p)
+
+     
+-- | A rose tree containing additional node information         
+data SourceRose a = SourceRose { roseInfo :: a 
+                               , original :: Bool
+                               , roseChildren :: [SourceRose a]
+                               } deriving (Eq, Functor, Typeable, Data)
+
+instance Show a => Show (SourceRose a) where
+  show sr = show' 0 sr
+    where show' i (SourceRose {roseInfo,original,roseChildren})
+             = "\n" ++ replicate (2*i) (if original then '#' else '-')
+                    ++ show roseInfo 
+                    ++ concatMap (show' (i+1)) roseChildren
+ SourceCode/ToSourceTree.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE LambdaCase, DefaultSignatures, TypeOperators, MultiParamTypeClasses, FlexibleContexts
+           , FlexibleInstances, OverlappingInstances, ScopedTypeVariables #-}
+-- | Generically transforms an ADT into a 'SourceTree'
+module SourceCode.ToSourceTree where
+
+import GHC.Generics
+import Control.Applicative
+import Control.Monad.State
+import Data.Either
+import Data.Maybe
+import Data.SmartTrav
+import SourceCode.SourceTree
+import SourceCode.ASTNode
+import SourceCode.SourceInfo
+                         
+-- | An intermediate data struture. Used to construct a 'SourceRose' tree.
+data SourceRoseCollect a = RoseCollect [SourceRoseCollect a]
+                         | RoseInfo a
+     
+instance Show a => Show (SourceRoseCollect a) where
+  show = show' 0
+    where show' i (RoseCollect children) 
+            = "\n" ++ replicate (2*i) '#' ++ concatMap (show' (i+1)) children
+          show' i (RoseInfo inf) 
+            = "\n" ++ replicate (2*i) '#' ++ show inf
+     
+-- | Transforms the intermediate representation 'SourceRoseCollect' to a 'SourceRose'     
+collectRose :: forall a . (SourceInfo a) 
+            => SourceRoseCollect a -> SourceRose a
+collectRose = collectRose' (error "No ancestor node has source info.")
+  where collectRose' ancestor (RoseCollect coll) 
+          = case partitionRoses coll of 
+              ([inf], branch) -> SourceRose inf True 
+                                            (map (collectRose' inf) branch)
+              ([], branch)    -> let children = map (collectRose' ancestor) branch
+                                  in SourceRose (generateInfo ancestor (map roseInfo children)) 
+                                                False children
+                                            
+              (infos, branch) -> SourceRose (generateInfo ancestor infos) False 
+                                            (map (collectRose' ancestor) branch)
+           where -- | Partition collected nodes into info nodes and subnodes
+                 partitionRoses :: [SourceRoseCollect a] -> ([a], [SourceRoseCollect a])
+                 partitionRoses = partitionEithers 
+                                    . (map $ \case c@(RoseCollect _) -> Right c
+                                                   RoseInfo i -> Left i)
+           
+-- | A class for converting AST tree into a more simpler rose tree, where the nodes are annotated
+-- with the node info of the original nodes.
+class (SourceInfo inf, SmartTrav n) => ToSourceRose n inf where
+  toRose :: n inf -> SourceRose inf
+  toRose tree = collectRose . toSourceRose $ tree
+  
+  -- | Creates an intermediate version of the rose tree
+  toSourceRose :: n inf -> SourceRoseCollect inf
+  toSourceRose n = evalState (toSrcRoseSt n) [[]]
+    where toSrcRoseSt :: n inf -> State [[SourceRoseCollect inf]] (SourceRoseCollect inf)
+          toSrcRoseSt n = smartTrav desc asc f n *> gets (RoseCollect . reverse . head)
+    
+          desc  = modify ([]:)
+          asc   = modify (\(x:y:xs) -> ((RoseCollect (reverse x) : y) : xs))
+          f inf = modify (\(x:xs) -> (RoseInfo inf : x) : xs)
+ Text/Parsec/ExtraCombinators.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE TupleSections #-}
+
+-- | Helper functions for parsing
+module Text.Parsec.ExtraCombinators where
+
+import Text.Parsec
+import Text.Parsec.PosOps
+import Control.Applicative hiding ((<|>), many, optional)
+import Data.List
+import Data.Function
+
+-- | Chooses one of the strings and returns the correspondig result.
+-- Builds a prefix tree to deal with overlapping strings
+choose :: Monad m => [(String, b)] -> ParsecT String u m b
+choose pars
+  = let sortedPars = reverse $ sortBy (compare `on` fst) pars
+        groupedPars = groupBy ((==) `on` (take 1 . fst)) sortedPars
+        dropFstChar ((c:rest),r) = (rest,r)
+        parsifyGroup gr@(([],r):_) = return r
+        parsifyGroup gr@(((c:rest),r):_) = char c *> choose (map dropFstChar gr)
+     in choice $ map parsifyGroup groupedPars
+
+-- | Only accepts the parse result if it fulfills the given condition. Otherwise causes a parse error with the specified message.
+onlyWhen :: String -> (a -> Bool) -> ParsecT s u m a -> ParsecT s u m a
+onlyWhen mess pred pars 
+  = do r <- pars
+       if pred r then return r
+                 else fail mess
+
+-- | Parses two elements into a tuple.
+tuple :: Monad m => ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m (a,b)
+tuple p1 p2 = (,) <$> p1 <*> p2
+               
+-- | Throws away the parsed element.
+skip :: ParsecT s u m a -> ParsecT s u m ()
+skip = (>> return ())
+
+-- | Parses an element but reverts the user state afterward.
+revertState :: Monad m => ParsecT s u m a -> ParsecT s u m a
+revertState p = do st <- getState
+                   res <- p
+                   setState st
+                   return res
+
+-- | Combines the result with the user state.
+resWithState :: Monad m => ParsecT s u m a -> ParsecT s u m (a,u)
+resWithState p = tuple p getState
+
+-- | Saves the original input that was parsed into the representation
+captureInputStr :: (Monad m) => ParsecT String u m a -> ParsecT String u m (a, String)
+captureInputStr p = do inpBefore <- getInput
+                       (res, rng) <- captureSourceRange p
+                       return (res, takeSourceRange (rngFromStart rng) inpBefore)
+
+captureSourceRange :: (Monad m) => ParsecT [s] u m a -> ParsecT [s] u m (a, SourceRange)
+captureSourceRange p = do pos0 <- getPosition
+                          res <- p
+                          pos1 <- getPosition
+                          return (res, srcRange pos0 pos1)                          
+             
+-- | Parses many occasions of an element until the end is parsed successfully. Returns both the parsed elements and the end element.
+manyUntil :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
+manyUntil p end = scan
+  where scan = (([], ) <$> end) <|> ((\e (ls,r) -> (e:ls, r)) <$> p <*> scan)
+                 
+-- | Parses two different element and gives it back as Left or Right
+(<||>) :: ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m (Either a b)
+p <||> q = Left <$> p <|> Right <$> q 
+
+-- | Parses any number of transformations and an argument. Applies the argument to the combination of the transformations from left to right.      
+manyApp :: Monad m => ParsecT s u m (a -> a) -> ParsecT s u m a -> ParsecT s u m a
+manyApp pf pa = do funs <- many pf
+                   arg <- pa
+                   return (foldl (flip ($)) arg funs)
+
+-- | Returns true if the given element is successfully parsed, false otherwise
+ifAccept :: ParsecT s u m a -> ParsecT s u m Bool
+ifAccept p = (try p *> return True) <|> return False         
+
+
+ Text/Parsec/PosOps.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Operations on source positions 
+module Text.Parsec.PosOps where
+
+import Text.Parsec
+import Text.Parsec.Pos
+import Data.Function
+import Data.Data
+import Debug.Trace
+
+-- * Utils on source positions
+
+-- | Shows a source position in a @line:col@ format, omitting file name.
+shortShow :: SourcePos -> String
+shortShow sp = show (sourceLine sp) ++ ":" ++ show (sourceColumn sp)
+  
+-- | Initial position in the same file as 
+initPosIn :: SourcePos -> SourcePos
+initPosIn sp = initialPos (sourceName sp)
+  
+takeToPos' sp = takeToPos sp (initPosIn sp)
+dropToPos' sp = dropToPos sp (initPosIn sp)
+  
+takeToPos :: SourcePos -> SourcePos -> String -> (SourcePos, String)
+takeToPos to curr (c:s) | curr < to  = let (endPos, res) = takeToPos to (updatePosChar curr c) s
+                                        in (endPos, c : res)
+takeToPos to curr s                  = (curr, [])
+
+dropToPos :: SourcePos -> SourcePos -> String -> (SourcePos, String)
+dropToPos to curr (c:s) | curr < to  = dropToPos to (updatePosChar curr c) s
+dropToPos to curr s                  = (curr, s)
+
+-- * Source Ranges
+
+-- | A range of characters in a source file given by a begin and an end position.
+data SourceRange = SourceRange { srcRangeBegin :: SourcePos 
+                               , srcRangeEnd   :: SourcePos
+                               } deriving (Eq, Ord, Typeable, Data)
+                               
+instance Show SourceRange where
+  show sr = show (srcRangeBegin sr) ++ " -- " ++ show (srcRangeEnd sr)
+
+-- | Shows a range in a @line:col-line:col@ format
+shortShowRng :: SourceRange -> String
+shortShowRng sr = shortShow (srcRangeBegin sr) ++ "-" ++ shortShow (srcRangeEnd sr)
+
+  
+-- | Creates a source range between two source positions
+srcRange :: SourcePos -> SourcePos -> SourceRange
+srcRange pos0 pos1 = if pos0 < pos1 then SourceRange pos0 pos1
+                                    else SourceRange pos1 pos0
+                               
+-- | True, if a source range is completely inside another range
+rangeInside :: SourceRange -> SourceRange -> Bool
+(SourceRange from1 to1) `rangeInside` (SourceRange from2 to2) 
+  = from2 <= from1 && to1 <= to2 && from2 < to1  
+  
+-- | True, if a source range is completely inside another range
+rangeStrictInside :: SourceRange -> SourceRange -> Bool
+(SourceRange from1 to1) `rangeStrictInside` (SourceRange from2 to2) 
+  = from2 <= from1 && to1 <= to2 && (from2 < from1 || to1 < to2)
+                               
+-- | True, two source ranges overlap
+rangeOverlaps :: SourceRange -> SourceRange -> Bool
+(SourceRange from1 to1) `rangeOverlaps` (SourceRange from2 to2) 
+  = (from1 <= from2 && from2 <= to1) || (from1 <= to2 && to2 <= to1)
+
+-- | The smallest range that contains the two given range.
+srcRngUnion :: SourceRange -> SourceRange -> SourceRange
+srcRngUnion sr1 sr2 = SourceRange ((min `on` srcRangeBegin) sr1 sr2) ((max `on` srcRangeEnd) sr1 sr2)
+
+-- | Returns a range that has the same size as the given range but starts from file position of zero.
+rngFromStart :: SourceRange -> SourceRange
+rngFromStart rng = rangeRelativelyTo rng (srcRangeBegin rng)
+
+-- | Returns an empty range at the beginning of the given range.
+rngStartAsRange :: SourceRange -> SourceRange
+rngStartAsRange (SourceRange begin _) = SourceRange begin begin
+
+-- | Returns an empty range at the end of the given range.
+rngEndAsRange :: SourceRange -> SourceRange
+rngEndAsRange (SourceRange _ end) = SourceRange end end
+
+-- | True, iff the range is empty
+emptyRange :: SourceRange -> Bool
+emptyRange (SourceRange begin end) = (begin == end)
+
+-- | Addition on source positions.
+offsetedBy :: SourcePos -> SourcePos -> SourcePos 
+sp1 `offsetedBy` sp2 
+  = newPos (sourceName sp1) (sourceLine sp1 + sourceLine sp2 - 1) (if sourceLine sp2 == 1 then sourceColumn sp1 + sourceColumn sp2 - 1 else sourceColumn sp2)
+
+-- | Substraction on source positions.
+relativelyTo :: SourcePos -> SourcePos -> SourcePos
+sp1 `relativelyTo` sp2 
+  = let newLine = sourceLine sp1 - sourceLine sp2 + 1
+     in newPos (sourceName sp1) newLine (if newLine == 1 then sourceColumn sp1 - sourceColumn sp2 + 1 else sourceColumn sp1)
+      
+-- | Gets a source range, with a specified position substracted from beginning and end.
+rangeRelativelyTo :: SourceRange -> SourcePos -> SourceRange
+sr `rangeRelativelyTo` sp = rangeMapBoth (`relativelyTo` sp) sr
+  
+-- | Applies a function on source positions to both begin and end of range
+rangeMapBoth :: (SourcePos -> SourcePos) -> SourceRange -> SourceRange
+rangeMapBoth f (SourceRange sp0 sp1) = SourceRange (f sp0) (f sp1)
+
+-- | Takes a substring indicated by a source range from the contents of the file
+takeSourceRange :: SourceRange -> String -> String
+takeSourceRange (SourceRange from to) s
+  = let init = (initialPos (sourceName from))
+        (startPos,startsAtPos) = dropToPos from init s
+     in snd $ takeToPos to startPos startsAtPos
+
+
+ Text/Preprocess/Helpers.hs view
@@ -0,0 +1,12 @@+module Text.Preprocess.Helpers where
+
+import Data.Char (isSpace)
+
+trimWhiteSpace = dropWhile isSpace . reverse . dropWhile isSpace . reverse         
+            
+updateWhere :: (a -> Maybe a) -> [a] -> Maybe [a]
+updateWhere f [] = Nothing
+updateWhere f (head:rest) = case f head of
+  Just x -> Just (x : rest)
+  Nothing -> fmap (head :) (updateWhere f rest)
+
+ Text/Preprocess/Parser.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE FlexibleContexts, KindSignatures #-}
+
+-- | Generic components for a preprocessor. Support for macro definitions with or without parameters, comments, file includes, conditional compilation.
+module Text.Preprocess.Parser where
+
+import Text.Parsec hiding (label)
+import Text.Preprocess.Rewrites
+import Text.ParserCombinators.Parsec.Pos
+import Text.Parsec.ExtraCombinators
+import Control.Monad.Identity
+import Control.Monad.Trans
+import Control.Applicative hiding ((<|>), many, optional)
+import Data.List
+import Data.Maybe
+import Data.Either
+import Debug.Trace
+
+-- | Contains the specification of the preprocessor
+data Preprocessor s u appl (m :: * -> *)
+  = Preprocessor { macroDef :: ParsecT s (u, PPState s u appl) m (MacroDef appl)
+                 , comments :: ParsecT s (u, PPState s u appl) m ()
+                 , -- | Should parse all occasions where a macro replacement could occur.
+                   macroAppl :: ParsecT s (u, PPState s u appl) m appl
+                 , includeDirective :: FilePath -> ParsecT s (u, PPState s u appl) m (String, FilePath)
+                 , condDirective :: PPState s u appl -> ParsecT s (u, PPState s u appl) m [PPRes]
+                 , failDirective :: ParsecT s (u, PPState s u appl) m ()
+                 , identToken :: ParsecT s (u, PPState s u appl) m String
+                 }
+
+-- | A default preprocessor with no parsers defined.
+defaultPreprocessor :: Preprocessor s u appl m
+defaultPreprocessor = Preprocessor { macroDef = fail "No macros defined" 
+                                   , comments = fail "No comments defined"
+                                   , macroAppl = fail "No macro application defined" 
+                                   , includeDirective = fail "No include directive defined"
+                                   , condDirective = fail "No cond directive defined"
+                                   , failDirective = fail "No failure directive defined"
+                                   , identToken = fail "No identifier token defined"
+                                   }
+    
+-- | All information about a macro definition
+--
+-- Contains it's name (for debugging), the way macro definition conflicts are resolved and a function
+-- that decides if a possible source code can be rewritten by this macro and does the rewrite if so.
+data MacroDef appl
+  = MacroDef { name :: String
+             , resolveConflict :: MacroDef appl -> Maybe (MacroDef appl)
+             , macroExpand :: appl -> Maybe (Either String [PPRes])
+             }
+             
+instance Show (MacroDef appl) where
+  show md = "MacroDef { name = " ++ name md ++ ", ... }"
+             
+-- | Wraps a part of a generated source code with the information that it is to be preprocessed again or not.
+data PPRes = PPAgain { fromPPRes :: String }
+           | NoPP { fromPPRes :: String }
+                 
+-- | Preprocessing state
+data PPState s u appl 
+  = PPState { defs :: [MacroDef appl] -- ^ Defined macros
+            , rewrites :: RewriteSet  -- ^ Performed rewrites
+            , genPos :: SourcePos     -- ^ Current position in the generated file, 
+                                      -- to keep track of destination position of rewrites
+            } deriving Show
+       
+-- | Creates an initial preprocessing state for parsing a file with the given name.       
+initState :: FilePath -> PPState s u appl
+initState fileName = PPState [] emptyRewSet (initialPos fileName)
+               
+-- | The parser type that includes preprocessing state in the user state
+type PPParserT s u appl m a 
+  = ParsecT s (u, PPState s u appl) m a
+                           
+-- | Instructs the preprocessor to modify the macro definition table                       
+modifyDefs :: (Monad m) => ([MacroDef appl] -> Either String [MacroDef appl]) -> PPParserT s u appl m ()
+modifyDefs f = do (u,s) <- getState
+                  case f (defs s) of Right defs' -> putState (u,s { defs = defs' })
+                                     Left err -> fail err
+
+-- | Registers a rewrite, so it can be undone when the original source is queried
+registerRewrite :: (Monad m) => SourcePos -> String -> String -> RewriteTrigger -> PPParserT s u appl m ()
+registerRewrite origPos origStr toStr trig
+  = modifyState $ \(u,s) -> (u, s { rewrites = addRewrite (createRewrite origPos origStr (genPos s) toStr trig) (rewrites s) })
+  
+-- | Updates the generated position
+moveGenPos :: (Monad m) => String -> PPParserT s u appl m ()
+moveGenPos s = modifyState $ \(u,st) -> (u,st { genPos = updatePosString (genPos st) s })
+  
+-- | Runs the preprocessor on a complete source file
+preprocessSource :: Monad m => Preprocessor String u appl m
+                -> PPParserT String u appl m (String, (u, PPState String u appl))
+preprocessSource pp = (,) <$> preprocess pp <* eof <*> getState
+  
+-- | Preprocesses the source, returns preprocessing state.
+-- Runs while the source is valid for preprocessing. 
+-- Can be used to capture branches of conditionally compiled source code.
+preprocess :: Monad m => Preprocessor String u appl m
+                -> PPParserT String u appl m String
+preprocess pp 
+  = do dir <- sourceName <$> getPosition
+       (concat . concat) <$> many ( try $ do 
+         pos <- getPosition
+         ((prepRes, file, trig), src) <- captureInputStr $
+                      (comments pp >> return ([], dir, CommentRemoval)) 
+                         <|> (parseDefine pp >> return ([], dir, MacroDefinition))
+                         <|> ( do (r, newFile) <- includeDirective pp dir
+                                  return ([PPAgain r], newFile, IncludeTriggered) ) 
+                         <|> (try (replaceDefine pp) >>= \ppres -> return (ppres, dir, MacroRewrite)) 
+                         <|> (identToken pp >>= \str -> return ([NoPP str], dir, MacroRewrite))
+                         <|> (do st <- snd <$> getState
+                                 ppres <- condDirective pp st 
+                                 return (ppres, dir, IfDefTriggered))
+                         <|> (failDirective pp *> undefined)
+                         <|> (anyChar >>= \c -> return ([NoPP [c]], dir, MacroRewrite))
+         let strRes = concatMap fromPPRes prepRes
+         when (src /= strRes) $ do
+             registerRewrite pos src strRes trig
+         moveGenPos strRes
+         mapM (\r -> case r of NoPP s -> return s
+                               PPAgain s -> runPreprocAgain file s) prepRes
+         )
+  where runPreprocAgain file s = do 
+          st <- getState
+          pos <- getPosition
+          res <- lift $ runParserT ( do setPosition (setSourceName pos file)
+                                        preprocessSource pp
+                                   ) st file s
+          case res of
+            Right (resTxt, resSt) -> 
+              do setState resSt
+                 return resTxt
+            Left err -> fail (show err)
+      
+-- | Parses a define directive
+parseDefine :: Monad m => Preprocessor String u appl m 
+                 -> PPParserT String u appl m ()
+parseDefine pp 
+  = do (macro, src) <- captureInputStr (macroDef pp)
+       modifyDefs (\defs -> case find (\m -> name m == name macro) defs of 
+                              Just other -> case resolveConflict macro other of
+                                              Just newMacro -> Right $ newMacro : defs
+                                              Nothing -> Left "Macro redefined"
+                              Nothing -> Right $ macro : defs )
+       
+-- | Replaces a name of a define with its body
+replaceDefine :: Monad m => Preprocessor String u appl m 
+                   -> PPParserT String u appl m [PPRes]
+replaceDefine pp = try $ do st <- getState
+                            appl <- macroAppl pp
+                            case partitionEithers $ catMaybes $ map (\md -> macroExpand md appl) (defs $ snd st) of
+                              (s:_, _) -> error s
+                              ([], []) -> fail ""
+                              ([], a:_) -> return a
+                
+-- | Creates a line comment that starts from the given symbol to the end of line     
+lineComment :: Monad m => String -> PPParserT String u appl m ()
+lineComment str = do try (string str)
+                     skip $ manyTill anyChar (skip (string "\n") <|> eof)
+             
+-- | Creates a block comment  
+blockComment :: Monad m => String -> String -> PPParserT String u appl m ()
+blockComment start end = skip $ do string start
+                                   manyTill anyChar (try (string end))
+ 
+
+ Text/Preprocess/Rewrites.hs view
@@ -0,0 +1,150 @@+module Text.Preprocess.Rewrites where
+
+import Data.Function
+import Text.Parsec
+import Text.Parsec.Pos
+import Text.Parsec.PosOps
+import Text.Parsec.ExtraCombinators
+import Text.Preprocess.Helpers
+
+-- | Invariant: there are no overlapping rewrites
+data RewriteSet = RewriteSet { rewriteSetElems :: [Rewrite] }
+                    deriving Show
+
+emptyRewSet :: RewriteSet
+emptyRewSet = RewriteSet []
+
+-- | Representation of a rewrite event
+data Rewrite = Rewrite { fromPos :: SourcePos
+                       , fromStr :: String
+                       , toPos :: SourcePos
+                       , toStr :: String
+                       , rewritesInside :: RewriteSet
+                       , source :: RewriteTrigger 
+                       } 
+
+-- | The cause of the rewrite
+data RewriteTrigger = CommentRemoval | EquRewrite | EquDefinition 
+                    | MacroRewrite | MacroDefinition | IfDefTriggered | IncludeTriggered 
+                      deriving Show                       
+   
+-- | Creates a new rewrite   
+createRewrite :: SourcePos -> String -> SourcePos -> String -> RewriteTrigger -> Rewrite
+createRewrite origPos origStr toPos toStr trig 
+  = Rewrite origPos origStr toPos toStr emptyRewSet trig
+  
+-- | Adds a rewrite to the rewrite set while keeping the invariant of the rewrite set
+addRewrite :: Rewrite -> RewriteSet -> RewriteSet
+addRewrite rew (RewriteSet others)
+  = if toStr rew == fromStr rew then RewriteSet others else 
+      case updateWhere insertIfContains others of
+        Just rews -> RewriteSet rews
+        Nothing -> RewriteSet (rew : others)
+      where insertIfContains r 
+              = if rew `rewInside` r then Just (r { rewritesInside = addRewrite rew (rewritesInside r) }) 
+                                     else Nothing
+  
+-- | Checks if a rewrite happened inside another rewrite
+rewInside :: Rewrite -> Rewrite -> Bool
+rewInside = rangeInside `on` toRange
+  
+-- | Simplifies a nested rewrite
+flattenRew :: Rewrite -> Rewrite
+flattenRew rew 
+  = let inners = (rewritesInside rew) `rewSetRelativelyTo` (fromPos rew) 
+     in rew { toStr = foldl (\str irew -> apply irew str) (toStr rew) (rewriteSetElems inners)
+            , toPos = correctPos inners (toPos rew)
+            , rewritesInside = emptyRewSet }
+  
+    
+-- | Gets the range where the rewrite happened in the original file
+fromRange :: Rewrite -> SourceRange
+fromRange rew@(Rewrite {fromPos = fromPos}) = SourceRange fromPos (fromEnd rew)
+
+fromEnd :: Rewrite -> SourcePos
+fromEnd (Rewrite {fromPos = fromPos, fromStr = fromStr}) = updatePosString fromPos fromStr
+
+-- | Gets the range where the rewrite results was inserted in the preprocessed file
+toRange :: Rewrite -> SourceRange
+toRange rew@(Rewrite { toPos = toPos }) = SourceRange toPos (toEnd rew)
+
+-- | Gets the end position of the code generated by the rewrite
+toEnd :: Rewrite -> SourcePos
+toEnd (Rewrite {toPos = toPos, toStr = toStr}) = updatePosString toPos toStr
+   
+-- | Do a rewrite
+apply :: Rewrite -> String -> String
+apply rw@(Rewrite fromPos fromStr toPos toStr inner _) s 
+  = doRewrite fromPos fromStr toStr "" (initialPos (sourceName fromPos)) s 
+
+-- | Undo a rewrite
+takeBack :: Rewrite -> String -> String
+takeBack rw@(Rewrite fromPos fromStr toPos toStr inner _) s 
+  = doRewrite toPos toStr fromStr "" (initialPos (sourceName fromPos)) s
+
+-- performs a rewrite, back or forth
+doRewrite fromPos fromStr toStr pre pos s 
+  | fromPos == pos
+  = let (pref,suf) = splitAt (length fromStr) s 
+     in if pref == fromStr then reverse pre ++ toStr ++ suf
+                           else error $ "doRewrite : not found the source str in position. Expected : " ++ fromStr ++ ", found: " ++ pref ++ ", in: " ++ s
+doRewrite fromPos fromStr toStr pre pos (head : tail)       
+  = doRewrite fromPos fromStr toStr (head : pre) (updatePosChar pos head) tail
+doRewrite fromPos fromStr toStr pre pos [] 
+  = error ("doRewrite : input had run out before position " ++ show fromPos ++ " found, while trying to do the substitution '" ++ fromStr ++ "' --> '" ++ toStr ++ "', after parsing " ++ pre)
+                       
+
+-- | Gets the original form of a parsed entry, before it was preprocessed
+-- rewrites that happened on the beginning or end of the element are not taken back.
+originalForm :: Monad m => RewriteSet -> ParsecT String u m a -> ParsecT String u m (a,String)
+originalForm (RewriteSet rews) p 
+  = do pos0 <- getPosition
+       (res,procSrc) <- captureInputStr p
+       pos1 <- getPosition
+       let procRng = SourceRange pos0 pos1
+       return $ (res, takeBackAll procSrc procRng pos0)
+  where takeBackAll str rng pos0
+          = foldl (flip takeBack) str (map (`rewRelativelyTo` pos0) (filterInside rews))
+          where filterInside = filter ((`rangeInside` rng) . toRange)
+          
+correctRange :: RewriteSet -> SourceRange -> SourceRange
+correctRange rews = rangeMapBoth (correctPos rews)
+          
+       
+-- | Gets the corresponding position in the original file. 
+-- If the position is inside a source range that is produced by a rewrite, the start position of the rewrite is returned.
+correctPos :: RewriteSet -> SourcePos -> SourcePos
+correctPos (RewriteSet rews) sp = case findEffectiveRew rews Nothing of
+          Right Nothing -> sp                      -- no rewrites before
+          Right (Just rew) -> correctByRew rew sp  -- correct by last rewrite
+          Left rew -> fromPos rew                  -- position is generated from rewrite
+  where findEffectiveRew :: [Rewrite] -> Maybe Rewrite -> Either Rewrite (Maybe Rewrite)
+        findEffectiveRew [] precRew = Right precRew
+        findEffectiveRew (rew:rews) precRew 
+          = if toPos rew <= sp && toEnd rew <= sp 
+                && (case precRew of Nothing -> True; Just prec -> toEnd prec < toEnd rew) then
+              findEffectiveRew rews (Just rew) 
+            else if toPos rew <= sp && toEnd rew > sp then
+              Left rew
+            else findEffectiveRew rews precRew
+
+-- | Transforms a position by a rewrite
+correctByRew :: Rewrite -> SourcePos -> SourcePos
+correctByRew rew sp = let flatRew = flattenRew rew
+                       in fromEnd flatRew `offsetedBy` (sp `relativelyTo` toEnd flatRew)
+          
+-- | Substracts the given position from the bounds of the rewrite
+rewRelativelyTo :: Rewrite -> SourcePos -> Rewrite
+(Rewrite fromPos fromStr toPos toStr inner trig) `rewRelativelyTo` sp 
+  = Rewrite (fromPos `relativelyTo` sp) fromStr (toPos `relativelyTo` sp) 
+            toStr (inner `rewSetRelativelyTo` sp) trig
+      
+-- | Substracts the given position from the bounds of all rewrites in a rewrite set.
+rewSetRelativelyTo :: RewriteSet -> SourcePos -> RewriteSet
+rewSetRelativelyTo (RewriteSet rews) sp = RewriteSet $ map (`rewRelativelyTo` sp) rews
+      
+instance Show Rewrite where
+  show (Rewrite fromPos fromStr toPos toStr inner trig) 
+    = show fromPos ++ " '" ++ fromStr ++ "' --> " ++ show toPos ++ " '" ++ toStr ++ "' (by " ++ show trig ++ ")" ++ show inner
+                       
+
+ cparsing.cabal view
@@ -0,0 +1,85 @@+name:                cparsing
+version:             0.1.0.0
+synopsis:            A simple C++ parser with preprocessor features. C++ refactorings included.
+description:
+  A simple implementation of a C++ parser using Parsec. It is defined with a custom AST and parser.
+  
+  The basic idea was to create a C++ representation that keeps its connection with the original
+  source code regardless of the preprocessor operations done on it. Each AST node that is expanded
+  from a macro expansion records that fact and their transformations are constrained to protect
+  the original structure of the program.
+  
+  A preprocessor implementation is given that tracks the macro expansions and this helps to create
+  an AST where the nodes refer to the original source code from which they were generated.
+  
+  The MiniC module contains the entry point of the parser, the CTransform package provides a transformation of the AST.
+  The C++ AST and parser and semantical analysis is defined in the MiniC package.
+  Traversing utilities are defined in the Data package.
+  General AST elements are defined in the SourceCode package.
+  
+  This is an early project of mine, the ideas behind this project are fully developed in the
+  Haskell-Tools project. Regardless, this early experience led me to continue using this approach.
+  
+  By the way, this is an old project I am no longer developing.
+
+license:             BSD3
+license-file:        LICENSE
+author:              Boldizsar Nemeth
+maintainer:          nboldi@elte.hu
+-- copyright:           
+category:            Language
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     RemixC
+                       MiniC
+                       CTransform
+                       Text.Preprocess.Rewrites
+                       Text.Preprocess.Parser
+                       Text.Preprocess.Helpers
+                       Text.Parsec.PosOps
+                       Text.Parsec.ExtraCombinators
+                       SourceCode.ToSourceTree
+                       SourceCode.SourceTree
+                       SourceCode.SourceInfo
+                       SourceCode.Parsec
+                       SourceCode.ASTNode
+                       SourceCode.ASTElems
+                       MiniC.TransformInfo
+                       MiniC.SymbolTable
+                       MiniC.SourceNotation
+                       MiniC.Semantics
+                       MiniC.Representation
+                       MiniC.RangeTree
+                       MiniC.PrettyPrint
+                       MiniC.Parser
+                       MiniC.ParseProgram
+                       MiniC.MiniCPP
+                       MiniC.Instances
+                       MiniC.Helpers
+                       MiniC.GenTemplate
+                       MiniC.AST
+                       MiniC.Parser.Lexical
+                       MiniC.Parser.Expr
+                       MiniC.Parser.Base
+                       Data.SmartTrav
+                       Data.SmartTrav.TH
+                       Data.SmartTrav.Instances
+                       Data.SmartTrav.Indexing
+                       Data.SmartTrav.Example
+                       Data.SmartTrav.Class
+  build-depends:       base >=4.10 && <4.11
+                     , parsec >=3.1 && <3.2
+                     , HUnit >=1.6 && <1.7
+                     , lens >=4.15 && <4.16
+                     , directory >=1.3 && <1.4
+                     , filepath >=1.4 && <1.5
+                     , either >=4.4 && <4.5
+                     , mtl >=2.2 && <2.3
+                     , containers >=0.5 && <0.6
+                     , split >=0.2 && <0.3
+                     , transformers >=0.5 && <0.6
+                     , template-haskell >=2.12 && <2.13
+  default-language:    Haskell2010