105 tvar2C _ (FunctionDeclaration (Identifier name _) returnType params Nothing) = do

   108 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do

   108     return $ t <+> text name <> parens p <> text ";"

   111     n <- id2C True name

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

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

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

   113     return $ 

   117     n <- id2C True name

   114         t <+> text name <> parens p

   118     return $ 

   119         t <+> n <> parens p

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

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

   129     if isConst then text "const" else empty

   134     t' <- type2C t

   130     <+>

   135     i <- mapM (id2C True) ids

   131     type2C t

   136     ie <- initExpr mInitExpr

   132     <+>

   137     return $ if isConst then text "const" else empty

   133     (hsep . punctuate (char ',') . map (\(Identifier i _) -> text i) $ ids)

   138         <+> t'

   134     <+>

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

   135     initExpr mInitExpr

   140         <+> ie

   136     <>

   141         <> text ";"

   137     text ";"

   142     where

   138     where

   143     initExpr Nothing = return $ empty

   139     initExpr Nothing = empty

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

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

   145 initExpr2C (InitBinOp op expr1 expr2) = parens $ (initExpr2C expr1) <+> op2C op <+> (initExpr2C expr2)

   149 initExpr2C (InitBinOp op expr1 expr2) = do

   146 initExpr2C (InitNumber s) = text s

   150     e1 <- initExpr2C expr1

   147 initExpr2C (InitFloat s) = text s

   151     e2 <- initExpr2C expr2

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

   152     o <- op2C op

   149 initExpr2C (InitString s) = doubleQuotes $ text s 

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

   150 initExpr2C (InitReference (Identifier i _)) = text i

   154 initExpr2C (InitNumber s) = return $ text s

   151 

   155 initExpr2C (InitFloat s) = return $ text s

   152 

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

   153 initExpr2C _ = text "<<expression>>"

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

   158 initExpr2C (InitReference i) = id2C False i

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

   160 

   156 type2C UnknownType = text "void"

   163 type2C UnknownType = return $ text "void"

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

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

   158 type2C (SimpleType (Identifier i _)) = text i

   165 type2C (SimpleType i) = id2C True i

   159 type2C (PointerTo t) = type2C t <> text "*"

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

   160 type2C (RecordType tvs union) = text "{" $+$ (nest 4 . vcat . map (tvar2C False) $ tvs) $+$ text "}"

   167 type2C (RecordType tvs union) = do

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

   168     t <- mapM (tvar2C False) tvs

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

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

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

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

   164 type2C (Set t) = text "<<set>>"

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

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

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

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

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

   168 phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"

   177 phrase2C (Phrases p) = do

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

   178     ps <- mapM phrase2C p

   170 phrase2C (ProcCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi

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

   171 phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $+$ (phrase2C . wrapPhrase) phrase1 $+$ elsePart

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

   172     where

   181 phrase2C (ProcCall ref params) = do

   173     elsePart | isNothing mphrase2 = empty

   182     r <- ref2C ref

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

   183     ps <- mapM expr2C params

   175 phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi

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

   176 phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase)

   185 phrase2C (IfThenElse (expr) phrase1 mphrase2) = do

   177 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases

   186     e <- expr2C expr

   178     where

   187     p1 <- (phrase2C . wrapPhrase) phrase1

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

   188     el <- elsePart

   180     case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map initExpr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")

   189     return $ 

   181 phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p)

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

   182 phrase2C (ForCycle (Identifier i _) e1 e2 p) = 

   191     where

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

   192     elsePart | isNothing mphrase2 = return $ empty

   184     $$

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

   185     phrase2C (wrapPhrase p)

   194 phrase2C (Assignment ref expr) = do

   186 phrase2C (RepeatCycle e p) = text "do" <+> phrase2C (Phrases p) <+> text "while" <> parens (text "!" <> parens (expr2C e))

   195     r <- ref2C ref 

   187 phrase2C NOP = text ";"

   196     e <- expr2C expr

   197     return $

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

   199 phrase2C (WhileCycle expr phrase) = do

   200     e <- expr2C expr

   201     p <- phrase2C $ wrapPhrase phrase

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

   203 phrase2C (SwitchCase expr cases mphrase) = do

   204     e <- expr2C expr

   205     cs <- mapM case2C cases

   206     return $ 

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

   208     where

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

   210     case2C (e, p) = do

   211         ie <- mapM initExpr2C e

   212         ph <- phrase2C p

   213         return $ 

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

   215 phrase2C (WithBlock ref p) = do

   216     r <- ref2C ref 

   217     ph <- phrase2C $ wrapPhrase p

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

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

   220     i <- id2C False i'

   221     e1 <- expr2C e1'

   222     e2 <- expr2C e2'

   223     ph <- phrase2C (wrapPhrase p)

   224     return $ 

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

   226         $$

   227         ph

   228 phrase2C (RepeatCycle e' p') = do

   229     e <- expr2C e'

   230     p <- phrase2C (Phrases p')

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

   232 phrase2C NOP = return $ text ";"

   195 expr2C (Expression s) = text s

   240 expr2C (Expression s) = return $ text s

   196 expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)

   241 expr2C (BinOp op expr1 expr2) = do

   197 expr2C (NumberLiteral s) = text s

   242     e1 <- expr2C expr1

   198 expr2C (FloatLiteral s) = text s

   243     e2 <- expr2C expr2

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

   244     o <- op2C op

   200 expr2C (StringLiteral s) = doubleQuotes $ text s 

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

   246 expr2C (NumberLiteral s) = return $ text s

   247 expr2C (FloatLiteral s) = return $ text s

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

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

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

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

   203 expr2C Null = text "NULL"

   252 expr2C Null = return $ text "NULL"

   204 expr2C (BuiltInFunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)

   253 expr2C (BuiltInFunCall params ref) = do

   205 expr2C _ = text "<<expression>>"

   254     r <- ref2C ref 

   255     ps <- mapM expr2C params

   256     return $ 

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

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

   209 ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs)

   262 ref2C (ArrayElement exprs ref) = do

   210 ref2C (SimpleReference (Identifier name _)) = text name

   263     r <- ref2C ref 

   211 ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2

   264     es <- mapM expr2C exprs

   212 ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2

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

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

   266 ref2C (SimpleReference name) = id2C False name

   214 ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)

   267 ref2C (RecordField (Dereference ref1) ref2) = do

   215 ref2C (Address ref) = text "&" <> parens (ref2C ref)

   268     r1 <- ref2C ref1 

   216 ref2C (TypeCast (Identifier t _) expr) = parens (text t) <> expr2C expr

   269     r2 <- ref2C ref2

   270     return $ 

   271         r1 <> text "->" <> r2

   272 ref2C (RecordField ref1 ref2) = do

   273     r1 <- ref2C ref1 

   274     r2 <- ref2C ref2

   275     return $ 

   276         r1 <> text "." <> r2

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

   278 ref2C (FunCall params ref) = do

   279     r <- ref2C ref

   280     ps <- mapM expr2C params

   281     return $ 

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

   283 ref2C (Address ref) = do

   284     r <- ref2C ref

   285     return $ text "&" <> parens r

   286 ref2C (TypeCast t' expr) = do

   287     t <- id2C False t'

   288     e <- expr2C expr

   289     return $ parens t <> e

   219 op2C "or" = text "|"

   292 

   220 op2C "and" = text "&"

   293 op2C :: String -> Reader a Doc

   221 op2C "not" = text "!"

   294 op2C "or" = return $ text "|"

   222 op2C "xor" = text "^"

   295 op2C "and" = return $ text "&"

   223 op2C "div" = text "/"

   296 op2C "not" = return $ text "!"

   224 op2C "mod" = text "%"

   297 op2C "xor" = return $ text "^"

   225 op2C "shl" = text "<<"

   298 op2C "div" = return $ text "/"

   226 op2C "shr" = text ">>"

   299 op2C "mod" = return $ text "%"

   227 op2C "<>" = text "!="

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

   228 op2C "=" = text "=="

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

   229 op2C a = text a

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

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

   304 op2C a = return $ text a