--- a/tools/pas2c/Pas2C.hs Tue Oct 20 20:09:44 2020 +0200
+++ 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')