equal
deleted
inserted
replaced
29 currentScope :: [Record], |
29 currentScope :: [Record], |
30 lastIdentifier :: String, |
30 lastIdentifier :: String, |
31 lastType :: BaseType, |
31 lastType :: BaseType, |
32 namespaces :: Map.Map String [Record] |
32 namespaces :: Map.Map String [Record] |
33 } |
33 } |
|
34 |
|
35 docToLower :: Doc -> Doc |
|
36 docToLower = text . map toLower . render |
34 |
37 |
35 pas2C :: String -> IO () |
38 pas2C :: String -> IO () |
36 pas2C fn = do |
39 pas2C fn = do |
37 setCurrentDirectory "../hedgewars/" |
40 setCurrentDirectory "../hedgewars/" |
38 s <- flip execStateT initState $ f fn |
41 s <- flip execStateT initState $ f fn |
254 p <- liftM hcat $ mapM (tvar2C False) params |
257 p <- liftM hcat $ mapM (tvar2C False) params |
255 n <- id2C IOInsert name |
258 n <- id2C IOInsert name |
256 return $ t <+> n <> parens p <> text ";" |
259 return $ t <+> n <> parens p <> text ";" |
257 |
260 |
258 tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
261 tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
259 t <- type2C returnType |
262 t <- type2C returnType |
260 (p, ph) <- withState' id $ do |
263 (p, ph) <- withState' id $ do |
261 p <- liftM hcat $ mapM (tvar2C False) params |
264 p <- liftM hcat $ mapM (tvar2C False) params |
262 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
265 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
263 return (p, ph) |
266 return (p, ph) |
264 n <- id2C IOInsert name |
267 n <- id2C IOInsert name |
|
268 let res = docToLower $ n <> text "_result" |
|
269 let phrasesBlock = case returnType of |
|
270 VoidType -> ph |
|
271 _ -> t <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
265 return $ |
272 return $ |
266 t <+> n <> parens p |
273 t <+> n <> parens p |
267 $+$ |
274 $+$ |
268 text "{" |
275 text "{" |
269 $+$ |
276 $+$ |
270 nest 4 ph |
277 nest 4 phrasesBlock |
271 $+$ |
278 $+$ |
272 text "}" |
279 text "}" |
273 where |
280 where |
274 phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p |
281 phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p |
275 phrase2C' p = phrase2C p |
282 phrase2C' p = phrase2C p |
277 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
284 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
278 |
285 |
279 tvar2C _ td@(TypeDeclaration i' t) = do |
286 tvar2C _ td@(TypeDeclaration i' t) = do |
280 i <- id2CTyped t i' |
287 i <- id2CTyped t i' |
281 tp <- type2C t |
288 tp <- type2C t |
282 return $ text "type" <+> i <+> tp <> text ";" |
289 return $ text "type" <+> i <+> tp <> semi |
283 |
290 |
284 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
291 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
285 t' <- type2C t |
292 t' <- type2C t |
286 i <- mapM (id2CTyped t) ids |
293 i <- mapM (id2CTyped t) ids |
287 ie <- initExpr mInitExpr |
294 ie <- initExpr mInitExpr |
311 initExpr2C (InitReference i) = id2C IOLookup i |
318 initExpr2C (InitReference i) = id2C IOLookup i |
312 initExpr2C _ = return $ text "<<expression>>" |
319 initExpr2C _ = return $ text "<<expression>>" |
313 |
320 |
314 |
321 |
315 type2C :: TypeDecl -> State RenderState Doc |
322 type2C :: TypeDecl -> State RenderState Doc |
316 type2C UnknownType = return $ text "void" |
323 type2C VoidType = return $ text "void" |
317 type2C (String l) = return $ text $ "string" ++ show l |
324 type2C (String l) = return $ text $ "string" ++ show l |
318 type2C (SimpleType i) = id2C IOLookup i |
325 type2C (SimpleType i) = id2C IOLookup i |
319 type2C (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i |
326 type2C (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i |
320 type2C (PointerTo t) = liftM (<> text "*") $ type2C t |
327 type2C (PointerTo t) = liftM (<> text "*") $ type2C t |
321 type2C (RecordType tvs union) = do |
328 type2C (RecordType tvs union) = do |
420 es <- mapM expr2C exprs |
427 es <- mapM expr2C exprs |
421 r <- ref2C ref |
428 r <- ref2C ref |
422 t <- gets lastType |
429 t <- gets lastType |
423 case t of |
430 case t of |
424 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
431 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
|
432 (BTString) -> modify (\st -> st{lastType = BTChar}) |
425 a -> error $ show a ++ "\n" ++ show ae |
433 a -> error $ show a ++ "\n" ++ show ae |
426 return $ r <> (brackets . hcat) (punctuate comma es) |
434 return $ r <> (brackets . hcat) (punctuate comma es) |
427 ref2C (SimpleReference name) = id2C IOLookup name |
435 ref2C (SimpleReference name) = id2C IOLookup name |
428 ref2C (RecordField (Dereference ref1) ref2) = do |
436 ref2C (RecordField (Dereference ref1) ref2) = do |
429 r1 <- ref2C ref1 |
437 r1 <- ref2C ref1 |