# HG changeset patch # User unC0Rr # Date 1603362815 -7200 # Node ID f09db263bc2aa9cc522dda0134650b8201b3ef4a # Parent a4558e2be08c0d5cf9c37ea58a76df14b9a867ed Mark global variables in implementation section static diff -r a4558e2be08c -r f09db263bc2a tools/pas2c/Pas2C.hs --- a/tools/pas2c/Pas2C.hs Wed Oct 21 18:55:26 2020 +0300 +++ b/tools/pas2c/Pas2C.hs Thu Oct 22 12:33:35 2020 +0200 @@ -13,7 +13,7 @@ import System.IO.Error import qualified Data.Map as Map import qualified Data.Set as Set -import Data.List (find) +import Data.List (find, stripPrefix) import Numeric import PascalParser @@ -145,13 +145,13 @@ where f = do checkDuplicateFunDecls tvs - mapM_ (tvar2C True False True False) tvs + mapM_ (tvar2C True False True False False) tvs toNamespace nss (Redo tvs) = -- functions that are re-implemented, add prefix to all of them currentScope $ execState f (emptyState nss){currentUnit = "fpcrtl_"} where f = do checkDuplicateFunDecls tvs - mapM_ (tvar2C True False True False) tvs + mapM_ (tvar2C True False True False False) tvs toNamespace _ (Program {}) = Map.empty toNamespace nss (Unit (Identifier i _) interface _ _ _) = currentScope $ execState (interface2C interface True) (emptyState nss){currentUnit = map toLower i ++ "_"} @@ -239,7 +239,7 @@ pascal2C (Program _ implementation mainFunction) = do impl <- implementation2C implementation - main <- liftM head $ tvar2C True False True True + main <- liftM head $ tvar2C True False True True False (FunctionDeclaration (Identifier "main" (BTInt True)) False False False (SimpleType $ Identifier "int" (BTInt True)) [VarDeclaration False False ([Identifier "argc" (BTInt True)], SimpleType (Identifier "Integer" (BTInt True))) Nothing , VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] @@ -254,19 +254,19 @@ interface2C :: Interface -> Bool -> State RenderState Doc interface2C (Interface uses tvars) True = do u <- uses2C uses - tv <- typesAndVars2C True True True tvars + tv <- typesAndVars2C True True True False tvars r <- renderStringConsts return (u $+$ r $+$ tv) interface2C (Interface uses tvars) False = do void $ uses2C uses - tv <- typesAndVars2C True False False tvars + tv <- typesAndVars2C True False False False tvars void $ renderStringConsts return tv implementation2C :: Implementation -> State RenderState Doc implementation2C (Implementation uses tvars) = do u <- uses2C uses - tv <- typesAndVars2C True False True tvars + tv <- typesAndVars2C True False True True tvars r <- renderStringConsts return (u $+$ r $+$ tv) @@ -283,10 +283,10 @@ -- the second bool indicates whether declare variable as extern or not -- the third bool indicates whether include types or not -typesAndVars2C :: Bool -> Bool -> Bool -> TypesAndVars -> State RenderState Doc -typesAndVars2C b externVar includeType(TypesAndVars ts) = do +typesAndVars2C :: Bool -> Bool -> Bool -> Bool -> TypesAndVars -> State RenderState Doc +typesAndVars2C b externVar includeType static (TypesAndVars ts) = do checkDuplicateFunDecls ts - liftM (vcat . map (<> semi) . concat) $ mapM (tvar2C b externVar includeType False) ts + liftM (vcat . map (<> semi) . concat) $ mapM (tvar2C b externVar includeType False static) ts setBaseType :: BaseType -> Identifier -> Identifier setBaseType bt (Identifier i _) = Identifier i bt @@ -459,7 +459,7 @@ functionParams2C :: [TypeVarDeclaration] -> State RenderState Doc -functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False False True True) params +functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False False True True False) params numberOfDeclarations :: [TypeVarDeclaration] -> Int numberOfDeclarations = sum . map cnt @@ -518,7 +518,7 @@ (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record resultId (if isVoid then (BTFunction hasVars False bts t') else t') empty] $ currentScope st , currentFunctionResult = if isVoid then [] else render res}) $ do p <- functionParams2C params - ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase) + ph <- liftM2 ($+$) (typesAndVars2C False False True False tvars) (phrase2C' phrase) return (p, ph) let isTrivialReturn = case phrase of @@ -555,11 +555,11 @@ -- the second bool indicates whether declare variable as extern or not -- the third bool indicates whether include types or not -- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params) -tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc] -tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _ _ _) = do +tvar2C :: Bool -> Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc] +tvar2C b _ includeType _ _ f@(FunctionDeclaration (Identifier name _) _ _ _ _ _ _) = do t <- fun2C b name f if includeType then return t else return [] -tvar2C _ _ includeType _ (TypeDeclaration i' t) = do +tvar2C _ _ includeType _ _ (TypeDeclaration i' t) = do i <- id2CTyped t i' tp <- type2C t let res = if includeType then [text "typedef" <+> tp i] else [] @@ -569,11 +569,11 @@ return res _ -> return res -tvar2C _ _ _ _ (VarDeclaration True _ (ids, t) Nothing) = do +tvar2C _ _ _ _ _ (VarDeclaration True _ (ids, t) Nothing) = do t' <- liftM ((empty <+>) . ) $ type2C t liftM (map(\i -> t' i)) $ mapM (id2CTyped2 (Just $ t' empty) (VarParamType t)) ids -tvar2C _ externVar includeType ignoreInit (VarDeclaration _ isConst (ids, t) mInitExpr) = do +tvar2C _ externVar includeType ignoreInit static (VarDeclaration _ isConst (ids, t) mInitExpr) = do t' <- liftM ((declDetails <+>) . ) $ type2C t ie <- initExpr mInitExpr lt <- gets lastType @@ -607,7 +607,7 @@ where declDetails = if isConst then text "static const" else if externVar then text "extern" - else empty + else if static then text "static" else empty initExpr Nothing = return $ empty initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) varDeclDecision True True varStr expStr = varStr <+> expStr @@ -620,7 +620,7 @@ ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported." _ -> 0 -tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do +tvar2C f _ _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do r <- op2CTyped op (extractTypes params) fun2C f i (FunctionDeclaration r inline False False ret params body) @@ -754,7 +754,7 @@ _ -> return $ \a -> i' <+> text "*" <+> a type2C' (PointerTo t) = liftM (\tx a -> tx (parens $ text "*" <> a)) $ type2C t type2C' (RecordType tvs union) = do - t' <- withState' f $ mapM (tvar2C False False True False) tvs + t' <- withState' f $ mapM (tvar2C False False True False False) tvs u <- unions return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t') $$ u) $+$ rbrace <+> i where @@ -765,7 +765,7 @@ structs <- mapM struct2C a return $ text "union" $+$ braces (nest 4 $ vcat structs) <> semi struct2C stvs = do - txts <- withState' f $ mapM (tvar2C False False True False) stvs + txts <- withState' f $ mapM (tvar2C False False True False False) stvs return $ text "struct" $+$ braces (nest 4 (vcat . map (<> semi) . concat $ txts)) <> semi type2C' (RangeType r) = return (text "int" <+>) type2C' (Sequence ids) = do @@ -920,7 +920,8 @@ error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb phrase2C (ForCycle i' e1' e2' p up) = do i <- id2C IOLookup i' - iType <- gets lastIdTypeDecl + -- hackishly strip 'static' from type declaration to workaround the use of global variables in 'for' cycles in uLandGenMaze + iType <- liftM (text . maybeStripPrefix "static " . show) $ gets lastIdTypeDecl e1 <- expr2C e1' e2 <- expr2C e2' let iEnd = i <> text "__end__" @@ -935,6 +936,7 @@ where appendPhrase p (Phrases ps) = Phrases $ ps ++ [p] appendPhrase _ _ = error "illegal appendPhrase call" + maybeStripPrefix prefix a = fromMaybe a $ stripPrefix prefix a phrase2C (RepeatCycle e' p') = do e <- expr2C e' p <- phrase2C (Phrases p')