diff -r addaeb1b9539 -r 67ea290ea843 tools/pas2c.hs --- a/tools/pas2c.hs Wed Dec 07 22:54:39 2011 +0300 +++ b/tools/pas2c.hs Wed Dec 07 23:04:57 2011 +0300 @@ -64,16 +64,18 @@ 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)] + 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 () @@ -124,7 +126,7 @@ mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds) return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses where - injectNamespace (Identifier i _) = do + 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}) @@ -153,6 +155,7 @@ p <- liftM hcat $ mapM (tvar2C False) params n <- id2C True name return $ t <+> n <> parens p <> text ";" + tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do t <- type2C returnType p <- liftM hcat $ mapM (tvar2C False) params @@ -169,11 +172,13 @@ where 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 i' t) = do tp <- type2C t 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 @@ -186,9 +191,11 @@ where initExpr Nothing = return $ empty initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) + tvar2C f (OperatorDeclaration op _ ret params body) = tvar2C f (FunctionDeclaration (Identifier ("") Unknown) ret params body) + initExpr2C :: InitExpression -> State RenderState Doc initExpr2C (InitBinOp op expr1 expr2) = do e1 <- initExpr2C expr1