208 pascal2C (Unit _ interface implementation init fin) = |
208 pascal2C (Unit _ interface implementation init fin) = |
209 liftM2 ($+$) (interface2C interface True) (implementation2C implementation) |
209 liftM2 ($+$) (interface2C interface True) (implementation2C implementation) |
210 |
210 |
211 pascal2C (Program _ implementation mainFunction) = do |
211 pascal2C (Program _ implementation mainFunction) = do |
212 impl <- implementation2C implementation |
212 impl <- implementation2C implementation |
213 [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction))) |
213 [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) False (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction))) |
214 return $ impl $+$ main |
214 return $ impl $+$ main |
215 |
215 |
216 |
216 |
217 -- the second bool indicates whether do normal interface translation or generate variable declarations |
217 -- the second bool indicates whether do normal interface translation or generate variable declarations |
218 -- that will be inserted into implementation files |
218 -- that will be inserted into implementation files |
239 checkDuplicateFunDecls tvs = |
239 checkDuplicateFunDecls tvs = |
240 modify $ \s -> s{toMangle = Map.keysSet . Map.filter (> 1) . foldr ins initMap $ tvs} |
240 modify $ \s -> s{toMangle = Map.keysSet . Map.filter (> 1) . foldr ins initMap $ tvs} |
241 where |
241 where |
242 initMap = Map.empty |
242 initMap = Map.empty |
243 --initMap = Map.fromList [("reset", 2)] |
243 --initMap = Map.fromList [("reset", 2)] |
244 ins (FunctionDeclaration (Identifier i _) _ _ _) m = Map.insertWith (+) (map toLower i) 1 m |
244 ins (FunctionDeclaration (Identifier i _) _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m |
245 ins _ m = m |
245 ins _ m = m |
246 |
246 |
247 -- the second bool indicates whether declare variable as extern or not |
247 -- the second bool indicates whether declare variable as extern or not |
248 -- the third bool indicates whether include types or not |
248 -- the third bool indicates whether include types or not |
249 |
249 |
427 abc = hcat . punctuate comma . map (char . fst) $ ps |
427 abc = hcat . punctuate comma . map (char . fst) $ ps |
428 cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps |
428 cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps |
429 ps = zip ['a'..] (toIsVarList params) |
429 ps = zip ['a'..] (toIsVarList params) |
430 |
430 |
431 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] |
431 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] |
432 fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do |
432 fun2C _ _ (FunctionDeclaration name inline returnType params Nothing) = do |
433 t <- type2C returnType |
433 t <- type2C returnType |
434 t'<- gets lastType |
434 t'<- gets lastType |
435 p <- withState' id $ functionParams2C params |
435 p <- withState' id $ functionParams2C params |
436 n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name |
436 n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name |
|
437 let decor = if inline then text "inline" else empty |
437 if hasVars then |
438 if hasVars then |
438 return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p] |
439 return [funWithVarsToDefine n params $+$ decor <+> t empty <+> text (n ++ "__vars") <> parens p] |
439 else |
440 else |
440 return [t empty <+> text n <> parens p] |
441 return [decor <+> t empty <+> text n <> parens p] |
441 where |
442 where |
442 hasVars = hasPassByReference params |
443 hasVars = hasPassByReference params |
443 |
444 |
444 |
445 |
445 fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do |
446 fun2C True rv (FunctionDeclaration name@(Identifier i _) inline returnType params (Just (tvars, phrase))) = do |
446 let res = docToLower $ text rv <> text "_result" |
447 let res = docToLower $ text rv <> text "_result" |
447 t <- type2C returnType |
448 t <- type2C returnType |
448 t'<- gets lastType |
449 t'<- gets lastType |
449 |
450 |
450 notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope |
451 notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope |
461 ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase) |
462 ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase) |
462 return (p, ph) |
463 return (p, ph) |
463 |
464 |
464 let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
465 let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
465 let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty |
466 let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty |
|
467 let decor = if inline then text "inline" else empty |
466 return [ |
468 return [ |
467 define |
469 define |
468 $+$ |
470 $+$ |
469 --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$ |
471 --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$ |
470 t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p |
472 decor <+> t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p |
471 $+$ |
473 $+$ |
472 text "{" |
474 text "{" |
473 $+$ |
475 $+$ |
474 nest 4 phrasesBlock |
476 nest 4 phrasesBlock |
475 $+$ |
477 $+$ |
478 phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p |
480 phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p |
479 phrase2C' p = phrase2C p |
481 phrase2C' p = phrase2C p |
480 un [a] b = a : b |
482 un [a] b = a : b |
481 hasVars = hasPassByReference params |
483 hasVars = hasPassByReference params |
482 |
484 |
483 fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
485 fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _) = error $ "nested functions not allowed: " ++ name |
484 fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv |
486 fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv |
485 |
487 |
486 -- the second bool indicates whether declare variable as extern or not |
488 -- the second bool indicates whether declare variable as extern or not |
487 -- the third bool indicates whether include types or not |
489 -- the third bool indicates whether include types or not |
488 -- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params) |
490 -- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params) |
489 tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc] |
491 tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc] |
490 tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _) = do |
492 tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _) = do |
491 t <- fun2C b name f |
493 t <- fun2C b name f |
492 if includeType then return t else return [] |
494 if includeType then return t else return [] |
493 tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do |
495 tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do |
494 i <- id2CTyped t i' |
496 i <- id2CTyped t i' |
495 tp <- type2C t |
497 tp <- type2C t |
543 arrayDimension a = case a of |
545 arrayDimension a = case a of |
544 ArrayDecl Nothing t -> let a = arrayDimension t in if a > 3 then error "Dynamic array with dimension > 4 is not supported." else 1 + arrayDimension t |
546 ArrayDecl Nothing t -> let a = arrayDimension t in if a > 3 then error "Dynamic array with dimension > 4 is not supported." else 1 + arrayDimension t |
545 ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported." |
547 ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported." |
546 _ -> 0 |
548 _ -> 0 |
547 |
549 |
548 tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) ret params body) = do |
550 tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do |
549 r <- op2CTyped op (extractTypes params) |
551 r <- op2CTyped op (extractTypes params) |
550 fun2C f i (FunctionDeclaration r ret params body) |
552 fun2C f i (FunctionDeclaration r inline ret params body) |
551 |
553 |
552 |
554 |
553 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier |
555 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier |
554 op2CTyped op t = do |
556 op2CTyped op t = do |
555 t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t |
557 t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t |