diff -r 608c8b057c3b -r cd0697c7e88b tools/pas2c.hs --- a/tools/pas2c.hs Thu Apr 05 14:58:34 2012 +0400 +++ b/tools/pas2c.hs Thu Apr 05 17:52:27 2012 +0400 @@ -103,12 +103,12 @@ nss <- gets namespaces withState' (\st -> st{currentScope = fromMaybe [] $ Map.lookup li (namespaces st)}) f -withRecordNamespace :: [(String, BaseType)] -> State RenderState Doc -> State RenderState Doc -withRecordNamespace [] = error "withRecordNamespace: empty record" -withRecordNamespace recs = withState' f +withRecordNamespace :: String -> [(String, BaseType)] -> State RenderState Doc -> State RenderState Doc +withRecordNamespace _ [] = error "withRecordNamespace: empty record" +withRecordNamespace prefix recs = withState' f where f st = st{currentScope = records ++ currentScope st} - records = map (\(a, b) -> (map toLower a, (a, b))) recs + records = map (\(a, b) -> (map toLower a, (prefix ++ a, b))) recs toCFiles :: Map.Map String [Record] -> (String, PascalUnit) -> IO () toCFiles _ (_, System _) = return () @@ -119,8 +119,8 @@ toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p toCFiles' (fn, (Unit unitId interface implementation _ _)) = do let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface) initialState - writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render a) - writeFile (fn ++ ".c") $ (render2C s . implementation2C) implementation + writeFile (fn ++ ".h") $ "#pragma once\n\n" ++ (render a) + writeFile (fn ++ ".c") $ "#include \"pas2c.h\"\n#include \"" ++ fn ++ ".h\"\n" ++ (render2C s . implementation2C) implementation initialState = emptyState ns render2C :: RenderState -> State RenderState Doc -> String @@ -342,6 +342,7 @@ initExpr2C (InitRecord fields) = do (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields return $ lbrace $+$ (nest 4 . vcat $ fs) $+$ rbrace +initExpr2C (InitArray [value]) = initExpr2C value initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values initExpr2C (InitRange _) = return $ text "<>" initExpr2C (InitSet _) = return $ text "<>" @@ -426,9 +427,7 @@ r <- ref2C ref t <- gets lastType case t of - (BTRecord rs) -> do - ph <- withRecordNamespace rs $ phrase2C $ wrapPhrase p - return $ text "namespace" <> parens r $$ ph + (BTRecord rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p a -> do ns <- gets currentScope error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb ++ "\nnamespace: " ++ show (take 100 ns) @@ -501,7 +500,7 @@ t <- fromPointer (show ref1) =<< gets lastType ns <- gets currentScope r2 <- case t of - BTRecord rs -> withRecordNamespace rs $ ref2C ref2 + BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2 BTUnit -> withLastIdNamespace $ ref2C ref2 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) return $ @@ -511,7 +510,7 @@ t <- gets lastType ns <- gets currentScope r2 <- case t of - BTRecord rs -> withRecordNamespace rs $ ref2C ref2 + BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2 BTUnit -> withLastIdNamespace $ ref2C ref2 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) return $ @@ -520,7 +519,7 @@ r <- ref2C ref t <- fromPointer (show d) =<< gets lastType modify (\st -> st{lastType = t}) - return $ (parens $ text "*") <> r + return $ (parens $ text "*" <> r) ref2C (FunCall params ref) = do ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params r <- ref2C ref