id2C :: Bool -> Identifier -> Reader a Doc

id2C isDecl (Identifier i _) = return $ text i

tvar2C _ (FunctionDeclaration name returnType params Nothing) = do

    n <- id2C True name

    return $ t <+> n <> parens p <> text ";"

tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do

    n <- id2C True name

        t <+> n <> parens p

tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do

    t' <- type2C t

    i <- mapM (id2C True) ids

    ie <- initExpr mInitExpr

    return $ if isConst then text "const" else empty

        <+> t'

        <+> (hsep . punctuate (char ',') $ i)

        <+> ie

        <> text ";"

    initExpr Nothing = return $ empty

    initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e)

initExpr2C (InitBinOp op expr1 expr2) = do

    e1 <- initExpr2C expr1

    e2 <- initExpr2C expr2

    o <- op2C op

    return $ parens $ e1 <+> o <+> e2

initExpr2C (InitNumber s) = return $ text s

initExpr2C (InitFloat s) = return $ text s

initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)

initExpr2C (InitString s) = return $ doubleQuotes $ text s 

initExpr2C (InitReference i) = id2C False i

initExpr2C _ = return $ text "<<expression>>"

type2C UnknownType = return $ text "void"

type2C (String l) = return $ text $ "string" ++ show l

type2C (SimpleType i) = id2C True i

type2C (PointerTo t) = liftM (<> text "*") $ type2C t

type2C (RecordType tvs union) = do

    t <- mapM (tvar2C False) tvs

    return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}"

type2C (RangeType r) = return $ text "<<range type>>"

type2C (Sequence ids) = return $ text "<<sequence type>>"

type2C (ArrayDecl r t) = return $ text "<<array type>>"

type2C (Set t) = return $ text "<<set>>"

type2C (FunctionType returnType params) = return $ text "<<function>>"

phrase2C (Phrases p) = do

    ps <- mapM phrase2C p

    return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}"

phrase2C (ProcCall f@(FunCall {}) []) = liftM (<> semi) $ ref2C f

phrase2C (ProcCall ref params) = do

    r <- ref2C ref

    ps <- mapM expr2C params

    return $ r <> parens (hsep . punctuate (char ',') $ ps) <> semi

phrase2C (IfThenElse (expr) phrase1 mphrase2) = do

    e <- expr2C expr

    p1 <- (phrase2C . wrapPhrase) phrase1

    el <- elsePart

    return $ 

        text "if" <> parens e $+$ p1 $+$ el

    elsePart | isNothing mphrase2 = return $ empty

             | otherwise = liftM (text "else" $$) $ (phrase2C . wrapPhrase) (fromJust mphrase2)

phrase2C (Assignment ref expr) = do

    r <- ref2C ref 

    e <- expr2C expr

    return $

        r <> text " = " <> e <> semi

phrase2C (WhileCycle expr phrase) = do

    e <- expr2C expr

    p <- phrase2C $ wrapPhrase phrase

    return $ text "while" <> parens e $$ p

phrase2C (SwitchCase expr cases mphrase) = do

    e <- expr2C expr

    cs <- mapM case2C cases

    return $ 

        text "switch" <> parens e <> text "of" $+$ (nest 4 . vcat) cs

    case2C :: ([InitExpression], Phrase) -> Reader a Doc

    case2C (e, p) = do

        ie <- mapM initExpr2C e

        ph <- phrase2C p

        return $ 

            text "case" <+> parens (hsep . punctuate (char ',') $ ie) <> char ':' <> nest 4 (ph $+$ text "break;")

phrase2C (WithBlock ref p) = do

    r <- ref2C ref 

    ph <- phrase2C $ wrapPhrase p

    return $ text "namespace" <> parens r $$ ph

phrase2C (ForCycle i' e1' e2' p) = do

    i <- id2C False i'

    e1 <- expr2C e1'

    e2 <- expr2C e2'

    ph <- phrase2C (wrapPhrase p)

    return $ 

        text "for" <> (parens . hsep . punctuate (char ';') $ [i <+> text "=" <+> e1, i <+> text "<=" <+> e2, text "++" <> i])

        $$

        ph

phrase2C (RepeatCycle e' p') = do

    e <- expr2C e'

    p <- phrase2C (Phrases p')

    return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e)

phrase2C NOP = return $ text ";"

expr2C (Expression s) = return $ text s

expr2C (BinOp op expr1 expr2) = do

    e1 <- expr2C expr1

    e2 <- expr2C expr2

    o <- op2C op

    return $ parens $ e1 <+> o <+> e2

expr2C (NumberLiteral s) = return $ text s

expr2C (FloatLiteral s) = return $ text s

expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)

expr2C (StringLiteral s) = return $ doubleQuotes $ text s 

expr2C (PrefixOp op expr) = liftM2 (<+>) (op2C op) (expr2C expr)

expr2C Null = return $ text "NULL"

expr2C (BuiltInFunCall params ref) = do

    r <- ref2C ref 

    ps <- mapM expr2C params

    return $ 

        r <> parens (hsep . punctuate (char ',') $ ps)

expr2C _ = return $ text "<<expression>>"

ref2C (ArrayElement exprs ref) = do

    r <- ref2C ref 

    es <- mapM expr2C exprs

    return $ r <> (brackets . hcat) (punctuate comma es)

ref2C (SimpleReference name) = id2C False name

ref2C (RecordField (Dereference ref1) ref2) = do

    r1 <- ref2C ref1 

    r2 <- ref2C ref2

    return $ 

        r1 <> text "->" <> r2

ref2C (RecordField ref1 ref2) = do

    r1 <- ref2C ref1 

    r2 <- ref2C ref2

    return $ 

        r1 <> text "." <> r2

ref2C (Dereference ref) = liftM ((parens $ text "*") <>) $ ref2C ref

ref2C (FunCall params ref) = do

    r <- ref2C ref

    ps <- mapM expr2C params

    return $ 

        r <> parens (hsep . punctuate (char ',') $ ps)

ref2C (Address ref) = do

    r <- ref2C ref

    return $ text "&" <> parens r

ref2C (TypeCast t' expr) = do

    t <- id2C False t'

    e <- expr2C expr

    return $ parens t <> e

op2C :: String -> Reader a Doc

op2C "or" = return $ text "|"

op2C "and" = return $ text "&"

op2C "not" = return $ text "!"

op2C "xor" = return $ text "^"

op2C "div" = return $ text "/"

op2C "mod" = return $ text "%"

op2C "shl" = return $ text "<<"

op2C "shr" = return $ text ">>"

op2C "<>" = return $ text "!="

op2C "=" = return $ text "=="

op2C a = return $ text a