tools/pas2c.hs
changeset 6883 70aec33185e2
parent 6880 34d3bc7bd8b1
child 6886 4463ee51c9ec
equal deleted inserted replaced
6882:0eb73121aa4c 6883:70aec33185e2
   117     toCFiles' p
   117     toCFiles' p
   118     where
   118     where
   119     toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p
   119     toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p
   120     toCFiles' (fn, (Unit unitId interface implementation _ _)) = do
   120     toCFiles' (fn, (Unit unitId interface implementation _ _)) = do
   121         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface) initialState
   121         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface) initialState
   122         writeFile (fn ++ ".h") $ "#pragma once\n\n" ++ (render (a $+$ text ""))
   122         writeFile (fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text ""))
   123         writeFile (fn ++ ".c") $ "#include \"pas2c.h\"\n#include \"" ++ fn ++ ".h\"\n" ++ (render2C s . implementation2C) implementation
   123         writeFile (fn ++ ".c") $ "#include \"" ++ fn ++ ".h\"\n" ++ (render2C s . implementation2C) implementation
   124     initialState = emptyState ns
   124     initialState = emptyState ns
   125 
   125 
   126     render2C :: RenderState -> State RenderState Doc -> String
   126     render2C :: RenderState -> State RenderState Doc -> String
   127     render2C a = render . ($+$ text "") . flip evalState a
   127     render2C a = render . ($+$ text "") . flip evalState a
   128 
   128 
   360     return $ parens $ e1 <+> text (op2C op) <+> e2
   360     return $ parens $ e1 <+> text (op2C op) <+> e2
   361 initExpr2C (InitNumber s) = return $ text s
   361 initExpr2C (InitNumber s) = return $ text s
   362 initExpr2C (InitFloat s) = return $ text s
   362 initExpr2C (InitFloat s) = return $ text s
   363 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
   363 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
   364 initExpr2C (InitString [a]) = return . quotes $ text [a]
   364 initExpr2C (InitString [a]) = return . quotes $ text [a]
   365 initExpr2C (InitString s) = return $ doubleQuotes $ text s 
   365 initExpr2C (InitString s) = return $ braces $ text ".s = " <> doubleQuotes (text s)
   366 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
   366 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
   367 initExpr2C (InitReference i) = id2C IOLookup i
   367 initExpr2C (InitReference i) = id2C IOLookup i
   368 initExpr2C (InitRecord fields) = do
   368 initExpr2C (InitRecord fields) = do
   369     (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
   369     (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
   370     return $ lbrace $+$ (nest 4 . vcat $ fs) $+$ rbrace
   370     return $ lbrace $+$ (nest 4 . vcat $ fs) $+$ rbrace