73 $+$ |
73 $+$ |
74 implementation2C implementation |
74 implementation2C implementation |
75 pascal2C (Program _ implementation mainFunction) = |
75 pascal2C (Program _ implementation mainFunction) = |
76 implementation2C implementation |
76 implementation2C implementation |
77 $+$ |
77 $+$ |
78 tvar2C True (FunctionDeclaration (Identifier "main") (SimpleType $ Identifier "int") [] (Just (TypesAndVars [], mainFunction))) |
78 tvar2C True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction))) |
79 |
79 |
80 |
80 |
81 interface2C :: Interface -> Doc |
81 interface2C :: Interface -> Doc |
82 interface2C (Interface uses tvars) = uses2C uses $+$ typesAndVars2C True tvars |
82 interface2C (Interface uses tvars) = uses2C uses $+$ typesAndVars2C True tvars |
83 |
83 |
90 |
90 |
91 uses2C :: Uses -> Doc |
91 uses2C :: Uses -> Doc |
92 uses2C uses = vcat $ map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses |
92 uses2C uses = vcat $ map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses |
93 |
93 |
94 uses2List :: Uses -> [String] |
94 uses2List :: Uses -> [String] |
95 uses2List (Uses ids) = map (\(Identifier i) -> i) ids |
95 uses2List (Uses ids) = map (\(Identifier i _) -> i) ids |
96 |
96 |
97 tvar2C :: Bool -> TypeVarDeclaration -> Doc |
97 tvar2C :: Bool -> TypeVarDeclaration -> Doc |
98 tvar2C _ (FunctionDeclaration (Identifier name) returnType params Nothing) = |
98 tvar2C _ (FunctionDeclaration (Identifier name _) returnType params Nothing) = |
99 type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params) <> text ";" |
99 type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params) <> text ";" |
100 tvar2C True (FunctionDeclaration (Identifier name) returnType params (Just (tvars, phrase))) = |
100 tvar2C True (FunctionDeclaration (Identifier name _) returnType params (Just (tvars, phrase))) = |
101 type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params) |
101 type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params) |
102 $+$ |
102 $+$ |
103 text "{" |
103 text "{" |
104 $+$ nest 4 ( |
104 $+$ nest 4 ( |
105 typesAndVars2C False tvars |
105 typesAndVars2C False tvars |
109 $+$ |
109 $+$ |
110 text "}" |
110 text "}" |
111 where |
111 where |
112 phrase2C' (Phrases p) = vcat $ map phrase2C p |
112 phrase2C' (Phrases p) = vcat $ map phrase2C p |
113 phrase2C' p = phrase2C p |
113 phrase2C' p = phrase2C p |
114 tvar2C False (FunctionDeclaration (Identifier name) _ _ _) = error $ "nested functions not allowed: " ++ name |
114 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
115 tvar2C _ (TypeDeclaration (Identifier i) t) = text "type" <+> text i <+> type2C t <> text ";" |
115 tvar2C _ (TypeDeclaration (Identifier i _) t) = text "type" <+> text i <+> type2C t <> text ";" |
116 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = |
116 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = |
117 if isConst then text "const" else empty |
117 if isConst then text "const" else empty |
118 <+> |
118 <+> |
119 type2C t |
119 type2C t |
120 <+> |
120 <+> |
121 (hsep . punctuate (char ',') . map (\(Identifier i) -> text i) $ ids) |
121 (hsep . punctuate (char ',') . map (\(Identifier i _) -> text i) $ ids) |
122 <+> |
122 <+> |
123 initExpr mInitExpr |
123 initExpr mInitExpr |
124 <> |
124 <> |
125 text ";" |
125 text ";" |
126 where |
126 where |
127 initExpr Nothing = empty |
127 initExpr Nothing = empty |
128 initExpr (Just e) = text "=" <+> initExpr2C e |
128 initExpr (Just e) = text "=" <+> initExpr2C e |
129 tvar2C f (OperatorDeclaration op _ ret params body) = |
129 tvar2C f (OperatorDeclaration op _ ret params body) = |
130 tvar2C f (FunctionDeclaration (Identifier $ "<op " ++ op ++ ">") ret params body) |
130 tvar2C f (FunctionDeclaration (Identifier ("<op " ++ op ++ ">") Unknown) ret params body) |
131 |
131 |
132 initExpr2C :: InitExpression -> Doc |
132 initExpr2C :: InitExpression -> Doc |
133 initExpr2C (InitBinOp op expr1 expr2) = parens $ (initExpr2C expr1) <+> op2C op <+> (initExpr2C expr2) |
133 initExpr2C (InitBinOp op expr1 expr2) = parens $ (initExpr2C expr1) <+> op2C op <+> (initExpr2C expr2) |
134 initExpr2C (InitNumber s) = text s |
134 initExpr2C (InitNumber s) = text s |
135 initExpr2C (InitFloat s) = text s |
135 initExpr2C (InitFloat s) = text s |
136 initExpr2C (InitHexNumber s) = text "0x" <> (text . map toLower $ s) |
136 initExpr2C (InitHexNumber s) = text "0x" <> (text . map toLower $ s) |
137 initExpr2C (InitString s) = doubleQuotes $ text s |
137 initExpr2C (InitString s) = doubleQuotes $ text s |
138 initExpr2C (InitReference (Identifier i)) = text i |
138 initExpr2C (InitReference (Identifier i _)) = text i |
139 |
139 |
140 |
140 |
141 initExpr2C _ = text "<<expression>>" |
141 initExpr2C _ = text "<<expression>>" |
142 |
142 |
143 type2C :: TypeDecl -> Doc |
143 type2C :: TypeDecl -> Doc |
144 type2C UnknownType = text "void" |
144 type2C UnknownType = text "void" |
145 type2C (String l) = text $ "string" ++ show l |
145 type2C (String l) = text $ "string" ++ show l |
146 type2C (SimpleType (Identifier i)) = text i |
146 type2C (SimpleType (Identifier i _)) = text i |
147 type2C (PointerTo t) = type2C t <> text "*" |
147 type2C (PointerTo t) = type2C t <> text "*" |
148 type2C (RecordType tvs union) = text "{" $+$ (nest 4 . vcat . map (tvar2C False) $ tvs) $+$ text "}" |
148 type2C (RecordType tvs union) = text "{" $+$ (nest 4 . vcat . map (tvar2C False) $ tvs) $+$ text "}" |
149 type2C (RangeType r) = text "<<range type>>" |
149 type2C (RangeType r) = text "<<range type>>" |
150 type2C (Sequence ids) = text "<<sequence type>>" |
150 type2C (Sequence ids) = text "<<sequence type>>" |
151 type2C (ArrayDecl r t) = text "<<array type>>" |
151 type2C (ArrayDecl r t) = text "<<array type>>" |
165 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases |
165 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases |
166 where |
166 where |
167 case2C :: ([InitExpression], Phrase) -> Doc |
167 case2C :: ([InitExpression], Phrase) -> Doc |
168 case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map initExpr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;") |
168 case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map initExpr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;") |
169 phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p) |
169 phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p) |
170 phrase2C (ForCycle (Identifier i) e1 e2 p) = |
170 phrase2C (ForCycle (Identifier i _) e1 e2 p) = |
171 text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i]) |
171 text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i]) |
172 $$ |
172 $$ |
173 phrase2C (wrapPhrase p) |
173 phrase2C (wrapPhrase p) |
174 phrase2C (RepeatCycle e p) = text "do" <+> phrase2C (Phrases p) <+> text "while" <> parens (text "!" <> parens (expr2C e)) |
174 phrase2C (RepeatCycle e p) = text "do" <+> phrase2C (Phrases p) <+> text "while" <> parens (text "!" <> parens (expr2C e)) |
175 phrase2C NOP = text ";" |
175 phrase2C NOP = text ";" |
193 expr2C _ = text "<<expression>>" |
193 expr2C _ = text "<<expression>>" |
194 |
194 |
195 |
195 |
196 ref2C :: Reference -> Doc |
196 ref2C :: Reference -> Doc |
197 ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs) |
197 ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs) |
198 ref2C (SimpleReference (Identifier name)) = text name |
198 ref2C (SimpleReference (Identifier name _)) = text name |
199 ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2 |
199 ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2 |
200 ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2 |
200 ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2 |
201 ref2C (Dereference ref) = parens $ text "*" <> ref2C ref |
201 ref2C (Dereference ref) = parens $ text "*" <> ref2C ref |
202 ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) |
202 ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) |
203 ref2C (Address ref) = text "&" <> parens (ref2C ref) |
203 ref2C (Address ref) = text "&" <> parens (ref2C ref) |
204 ref2C (TypeCast (Identifier t) expr) = parens (text t) <> expr2C expr |
204 ref2C (TypeCast (Identifier t _) expr) = parens (text t) <> expr2C expr |
205 ref2C (RefExpression expr) = expr2C expr |
205 ref2C (RefExpression expr) = expr2C expr |
206 |
206 |
207 op2C "or" = text "|" |
207 op2C "or" = text "|" |
208 op2C "and" = text "&" |
208 op2C "and" = text "&" |
209 op2C "not" = text "!" |
209 op2C "not" = text "!" |