equal
deleted
inserted
replaced
64 |
64 |
65 escapeChar :: Char -> ShowS |
65 escapeChar :: Char -> ShowS |
66 escapeChar '"' s = "\\\"" ++ s |
66 escapeChar '"' s = "\\\"" ++ s |
67 escapeChar a s = a : s |
67 escapeChar a s = a : s |
68 |
68 |
|
69 strInit :: String -> Doc |
|
70 strInit a = text "STRINIT" <> parens (doubleQuotes (text $ escapeStr a)) |
|
71 |
69 renderStringConsts :: State RenderState Doc |
72 renderStringConsts :: State RenderState Doc |
70 renderStringConsts = liftM (vcat . map (\(a, b) -> text "STRCONSTDECL" <> parens (text a <> comma <+> doubleQuotes (text $ escapeStr b)) <> semi)) |
73 renderStringConsts = liftM (vcat . map (\(a, b) -> text "const string255" <+> (text a) <+> text "=" <+> strInit b <> semi)) |
71 $ gets stringConsts |
74 $ gets stringConsts |
72 |
75 |
73 docToLower :: Doc -> Doc |
76 docToLower :: Doc -> Doc |
74 docToLower = text . map toLower . render |
77 docToLower = text . map toLower . render |
75 |
78 |
181 return $ impl $+$ main |
184 return $ impl $+$ main |
182 |
185 |
183 |
186 |
184 |
187 |
185 interface2C :: Interface -> State RenderState Doc |
188 interface2C :: Interface -> State RenderState Doc |
186 interface2C (Interface uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars) |
189 interface2C (Interface uses tvars) = do |
187 |
190 u <- uses2C uses |
|
191 tv <- typesAndVars2C True tvars |
|
192 r <- renderStringConsts |
|
193 return (u $+$ r $+$ tv) |
|
194 |
188 implementation2C :: Implementation -> State RenderState Doc |
195 implementation2C :: Implementation -> State RenderState Doc |
189 implementation2C (Implementation uses tvars) = do |
196 implementation2C (Implementation uses tvars) = do |
190 u <- uses2C uses |
197 u <- uses2C uses |
191 tv <- typesAndVars2C True tvars |
198 tv <- typesAndVars2C True tvars |
192 r <- renderStringConsts |
199 r <- renderStringConsts |
406 return $ parens $ e1 <+> text (op2C op) <+> e2 |
413 return $ parens $ e1 <+> text (op2C op) <+> e2 |
407 initExpr2C (InitNumber s) = return $ text s |
414 initExpr2C (InitNumber s) = return $ text s |
408 initExpr2C (InitFloat s) = return $ text s |
415 initExpr2C (InitFloat s) = return $ text s |
409 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s) |
416 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s) |
410 initExpr2C (InitString [a]) = return . quotes $ text [a] |
417 initExpr2C (InitString [a]) = return . quotes $ text [a] |
411 initExpr2C (InitString s) = return $ braces $ text ".s = " <> doubleQuotes (text s) |
418 initExpr2C (InitString s) = return $ strInit s |
412 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "") |
419 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "") |
413 initExpr2C (InitReference i) = id2C IOLookup i |
420 initExpr2C (InitReference i) = id2C IOLookup i |
414 initExpr2C (InitRecord fields) = do |
421 initExpr2C (InitRecord fields) = do |
415 (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields |
422 (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields |
416 return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace |
423 return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace |