|
6273
|
1 |
module Pas2C where
|
|
|
2 |
|
|
|
3 |
import PascalParser
|
|
|
4 |
import Text.PrettyPrint.HughesPJ
|
|
|
5 |
import Data.Maybe
|
|
6277
|
6 |
import Data.Char
|
|
6273
|
7 |
|
|
|
8 |
|
|
|
9 |
pascal2C :: PascalUnit -> Doc
|
|
|
10 |
pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation
|
|
|
11 |
|
|
|
12 |
|
|
|
13 |
implementation2C :: Implementation -> Doc
|
|
|
14 |
implementation2C (Implementation uses tvars) = typesAndVars2C tvars
|
|
|
15 |
|
|
|
16 |
|
|
|
17 |
typesAndVars2C :: TypesAndVars -> Doc
|
|
|
18 |
typesAndVars2C (TypesAndVars ts) = vcat $ map tvar2C ts
|
|
|
19 |
|
|
|
20 |
|
|
|
21 |
tvar2C :: TypeVarDeclaration -> Doc
|
|
6307
|
22 |
tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) =
|
|
|
23 |
type2C returnType <+> text (name ++ "();")
|
|
6273
|
24 |
|
|
|
25 |
|
|
6307
|
26 |
tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) =
|
|
|
27 |
type2C returnType <+> text (name ++ "()")
|
|
6273
|
28 |
$$
|
|
|
29 |
phrase2C phrase
|
|
|
30 |
tvar2C _ = empty
|
|
|
31 |
|
|
6307
|
32 |
type2C :: TypeDecl -> Doc
|
|
|
33 |
type2C UnknownType = text "void"
|
|
|
34 |
type2C _ = text "<<type>>"
|
|
6273
|
35 |
|
|
|
36 |
phrase2C :: Phrase -> Doc
|
|
6307
|
37 |
phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"
|
|
6273
|
38 |
phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
|
|
6307
|
39 |
phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $+$ (phrase2C . wrapPhrase) phrase1 $+$ elsePart
|
|
6273
|
40 |
where
|
|
|
41 |
elsePart | isNothing mphrase2 = empty
|
|
6307
|
42 |
| otherwise = text "else" $$ (phrase2C . wrapPhrase) (fromJust mphrase2)
|
|
6277
|
43 |
phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi
|
|
6307
|
44 |
phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase)
|
|
|
45 |
phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases
|
|
6273
|
46 |
where
|
|
|
47 |
case2C :: (Expression, Phrase) -> Doc
|
|
6307
|
48 |
case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
|
|
6273
|
49 |
{-
|
|
|
50 |
| RepeatCycle Expression Phrase
|
|
|
51 |
| ForCycle
|
|
|
52 |
-}
|
|
|
53 |
phrase2C _ = empty
|
|
|
54 |
|
|
6307
|
55 |
wrapPhrase p@(Phrases _) = p
|
|
|
56 |
wrapPhrase p = Phrases [p]
|
|
6273
|
57 |
|
|
|
58 |
expr2C :: Expression -> Doc
|
|
|
59 |
expr2C (Expression s) = text s
|
|
6277
|
60 |
expr2C (FunCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
|
|
6307
|
61 |
expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)
|
|
6277
|
62 |
expr2C (NumberLiteral s) = text s
|
|
|
63 |
expr2C (HexNumber s) = text "0x" <> (text . map toLower $ s)
|
|
|
64 |
expr2C (StringLiteral s) = doubleQuotes $ text s
|
|
|
65 |
expr2C (Address ref) = text "&" <> ref2C ref
|
|
|
66 |
expr2C (Reference ref) = ref2C ref
|
|
6307
|
67 |
expr2C (PrefixOp op expr) = op2C op <+> expr2C expr
|
|
|
68 |
{-
|
|
6277
|
69 |
| PostfixOp String Expression
|
|
|
70 |
| CharCode String
|
|
6273
|
71 |
-}
|
|
|
72 |
expr2C _ = empty
|
|
|
73 |
|
|
6307
|
74 |
|
|
|
75 |
ref2C :: Reference -> Doc
|
|
|
76 |
ref2C (ArrayElement (Identifier name) expr) = text name <> brackets (expr2C expr)
|
|
|
77 |
ref2C (SimpleReference (Identifier name)) = text name
|
|
|
78 |
ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2
|
|
|
79 |
ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
|
|
|
80 |
ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
|
|
|
81 |
|
|
6275
|
82 |
op2C "or" = text "|"
|
|
|
83 |
op2C "and" = text "&"
|
|
6307
|
84 |
op2C "not" = text "!"
|
|
|
85 |
op2C "xor" = text "^"
|
|
6275
|
86 |
op2C "div" = text "/"
|
|
|
87 |
op2C "mod" = text "%"
|
|
6307
|
88 |
op2C "shl" = text "<<"
|
|
|
89 |
op2C "shr" = text ">>"
|
|
6275
|
90 |
op2C "<>" = text "!="
|
|
6277
|
91 |
op2C "=" = text "=="
|
|
6275
|
92 |
op2C a = text a
|
|
6273
|
93 |
|
|
|
94 |
maybeVoid "" = "void"
|
|
|
95 |
maybeVoid a = a
|