module CppAst where

import Debug.Trace

import CppToken
import Text.ParserCombinators.Parsec.Pos

data Declaration =
    Variable Declarator DeclType Expression
    -- Function declarations can also be seen as declarations of variables of
    -- function type
    -- | FunctionDeclaration Declarator DeclType [Declaration]
    | Function Declarator DeclType Statement
    deriving Show

data Declarator =
    DeclaratorId String
    | AbstractDeclarator
	deriving Show

data DeclType =
    PointerTo DeclType
    | PointerToMember {
        fromClass :: DeclType,
        ptrToType :: DeclType,
        cvQualifiers :: CVQual}
    | ReferenceTo DeclType
    | ArrayOf Expression DeclType
    | BuiltinType Tok [Tok]
    | QualifiedType CVQual DeclType
    | FunctionType DeclType [Declaration] {- exception specification -}
    deriving (Show)

data Statement =
    ReturnStatement Expression
    | CompoundStatement [Statement]
    | NullStatement
    deriving (Show)

data Constant =
	StringConstant String
	| IntegerConstant Integer
	deriving (Show)

data Expression =
    NullExpr
    | ConstantExpr Constant
    deriving (Show)

data Linkage =
    External
    | Static
    | Auto
    deriving (Show)

-- CVQuals Constness Volatileness
data CVQual =
    CV Bool Bool
    deriving (Show)

type DeclSpecs = [Token]
type DeclarationMaker = (DeclType -> DeclType) -> DeclSpecs -> Declaration

defaultQual = CV False False
constQual = CV True False
volatileQual = CV False True
constVolatileQual = CV True True

qualAddVolatile (CV c False) = (CV c True)
qualAddVolatile (CV c True) = error "Redundant volatile"
qualAddConst (CV False v) = (CV True v)
qualAddConst (CV True v) = error "Redundant const"

addQual (CV c True) = qualAddVolatile . addQual (CV c False)
addQual (CV True v) = qualAddConst . addQual (CV False v)
addQual (CV False False) = id

updateQuals f decl = setQuals decl $ f $ getQuals decl

setQuals (QualifiedType _ decl) quals = QualifiedType quals decl
setQuals decl quals = QualifiedType quals decl

getQuals (QualifiedType q _) = q
getQuals _ = defaultQual

getQualDecl = id

addVolatile = updateQuals qualAddVolatile
addConst = updateQuals qualAddConst

cvQualify (_, Reserved "const") = addConst
cvQualify (_, Reserved "volatile") = addVolatile

cvQualifyList = flip (foldr cvQualify)

getDeclType (Variable _ tp _) = tp
getDeclType (Function _ tp _) = tp

makeDeclaration :: DeclType -> Declarator -> Declaration
makeDeclaration declType decl =
	Variable decl declType NullExpr

makeDeclarationMaker :: Declarator -> DeclarationMaker
makeDeclarationMaker ident f declSpecs =
	makeDeclaration (f $ declSpecsToType declSpecs) ident

makeFunction :: Declaration -> Statement -> Declaration
makeFunction (Variable decl declType@(FunctionType _ _) expr) body =
	(Function decl declType body)
makeFunction x _ = error ("Ooops: don't know how to makeFunction from "++(show x))

declSpecsToType xs = BuiltinType (Reserved "int") $ map snd xs

data Scope =
    Scope { decls :: [Declaration], parentScope :: Scope }
    | NullScope
    deriving Show
data CompilerState =
	CompilerState {
    	externals :: [Declaration],
    	currentScope :: Scope }
    deriving Show

newCompilerState = CompilerState [] (newScope NullScope)

newScope parent = (Scope [] parent)

addExternal :: Declaration -> CompilerState -> CompilerState
addExternal x s = s { externals = (x:externals s) }

stateAddDecl :: Declaration -> CompilerState -> CompilerState
stateAddDecl = updateScope . addDecl

updateScope f state = state { currentScope = f (currentScope state) }

addDecl :: Declaration -> Scope -> Scope
addDecl x s = s { decls = x:decls s }

builtinIntType = BuiltinType (Reserved "int")