diff -r 74a04089bb56 -r addaeb1b9539 tools/pas2c.hs --- a/tools/pas2c.hs Wed Dec 07 11:35:03 2011 -0500 +++ b/tools/pas2c.hs Wed Dec 07 22:54:39 2011 +0300 @@ -17,7 +17,11 @@ import PascalParser import PascalUnitSyntaxTree -type RenderState = [(String, String)] +data RenderState = RenderState + { + currentScope :: [(String, String)], + namespaces :: Map.Map String [(String, String)] + } pas2C :: String -> IO () pas2C fn = do @@ -57,20 +61,35 @@ renderCFiles :: Map.Map String PascalUnit -> IO () renderCFiles units = do let u = Map.toList units - mapM_ toCFiles u - -toCFiles :: (String, PascalUnit) -> IO () -toCFiles (_, System _) = return () -toCFiles p@(fn, pu) = do + let ns = Map.map toNamespace units + mapM_ (toCFiles ns) u + where + toNamespace :: PascalUnit -> [(String, String)] + toNamespace = concatMap tv2id . extractTVs + extractTVs (System tv) = tv + extractTVs (Program {}) = [] + extractTVs (Unit _ (Interface _ (TypesAndVars tv)) _ _ _) = tv + tv2id :: TypeVarDeclaration -> [(String, String)] + tv2id (TypeDeclaration (Identifier i _) _) = [(map toLower i, i)] + tv2id (VarDeclaration _ (ids, _) _) = map (\(Identifier i _) -> (map toLower i, i)) ids + tv2id (FunctionDeclaration (Identifier i _) _ _ _) = [(map toLower i, i)] + tv2id (OperatorDeclaration i _ _ _ _) = [(map toLower i, i)] + + +toCFiles :: Map.Map String [(String, String)] -> (String, PascalUnit) -> IO () +toCFiles _ (_, System _) = return () +toCFiles ns p@(fn, pu) = do hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..." toCFiles' p where - toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C . pascal2C) p + toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C (RenderState [] ns) . pascal2C) p toCFiles' (fn, (Unit _ interface implementation _ _)) = do - writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render2C . interface2C $ interface) - writeFile (fn ++ ".c") $ (render2C . implementation2C) implementation + let (a, s) = runState (interface2C interface) (RenderState [] ns) + writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render a) + writeFile (fn ++ ".c") $ (render2C s . implementation2C) implementation -render2C = render . flip evalState [] + render2C :: RenderState -> State RenderState Doc -> String + render2C a = render . flip evalState a usesFiles :: PascalUnit -> [String] usesFiles (Program _ (Implementation uses _) _) = "pas2cSystem" : uses2List uses @@ -101,7 +120,14 @@ typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts uses2C :: Uses -> State RenderState Doc -uses2C uses = return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses +uses2C uses@(Uses unitIds) = do + mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds) + return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses + where + injectNamespace (Identifier i _) = do + getNS <- gets (flip Map.lookup . namespaces) + let f = flip (foldl (\a b -> b:a)) (fromMaybe [] (getNS i)) + modify (\s -> s{currentScope = f $ currentScope s}) uses2List :: Uses -> [String] uses2List (Uses ids) = map (\(Identifier i _) -> i) ids @@ -109,13 +135,14 @@ id2C :: Bool -> Identifier -> State RenderState Doc id2C True (Identifier i _) = do - modify (\s -> (map toLower i, i) : s) + modify (\s -> s{currentScope = (map toLower i, i) : currentScope s}) return $ text i id2C False (Identifier i _) = do let i' = map toLower i - v <- gets $ find (\(a, _) -> a == i') + v <- gets $ find (\(a, _) -> a == i') . currentScope + --ns <- gets currentScope if isNothing v then - error $ "Not defined: " ++ i' + error $ "Not defined: '" ++ i' ++ "'"-- ++ show ns else return . text . snd . fromJust $ v @@ -143,9 +170,10 @@ phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p phrase2C' p = phrase2C p tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name -tvar2C _ (TypeDeclaration (Identifier i _) t) = do +tvar2C _ (TypeDeclaration i' t) = do tp <- type2C t - return $ text "type" <+> text i <+> tp <> text ";" + i <- id2C True i' + return $ text "type" <+> i <+> tp <> text ";" tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do t' <- type2C t i <- mapM (id2C True) ids