268 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) |
268 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) |
269 |
269 |
270 |
270 |
271 functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False) params |
271 functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False) params |
272 |
272 |
273 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState [Doc] |
273 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] |
274 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do |
274 fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do |
275 t <- type2C returnType |
275 t <- type2C returnType |
276 t'<- gets lastType |
276 t'<- gets lastType |
277 p <- withState' id $ functionParams2C params |
277 p <- withState' id $ functionParams2C params |
278 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
278 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
279 return [t empty <+> n <> parens p] |
279 return [t empty <+> n <> parens p] |
280 |
280 |
281 tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
281 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
|
282 let res = docToLower $ text rv <> text "_result" |
282 t <- type2C returnType |
283 t <- type2C returnType |
283 t'<- gets lastType |
284 t'<- gets lastType |
284 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
285 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
285 (p, ph) <- withState' (\st -> st{currentScope = (lastIdentifier st, (lastIdentifier st ++ "_result", t')) : currentScope st}) $ do |
286 (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, t')) : currentScope st}) $ do |
286 p <- functionParams2C params |
287 p <- functionParams2C params |
287 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
288 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
288 return (p, ph) |
289 return (p, ph) |
289 let res = docToLower $ n <> text "_result" |
|
290 let phrasesBlock = case returnType of |
290 let phrasesBlock = case returnType of |
291 VoidType -> ph |
291 VoidType -> ph |
292 _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
292 _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
293 return [ |
293 return [ |
294 t empty <+> n <> parens p |
294 t empty <+> n <> parens p |
300 text "}"] |
300 text "}"] |
301 where |
301 where |
302 phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p |
302 phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p |
303 phrase2C' p = phrase2C p |
303 phrase2C' p = phrase2C p |
304 |
304 |
305 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
305 fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
306 |
306 fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv |
|
307 |
|
308 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState [Doc] |
|
309 tvar2C b f@(FunctionDeclaration (Identifier name _) _ _ _) = |
|
310 fun2C b name f |
307 tvar2C _ td@(TypeDeclaration i' t) = do |
311 tvar2C _ td@(TypeDeclaration i' t) = do |
308 i <- id2CTyped t i' |
312 i <- id2CTyped t i' |
309 tp <- type2C t |
313 tp <- type2C t |
310 return [text "typedef" <+> tp i] |
314 return [text "typedef" <+> tp i] |
311 |
315 |
315 liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids |
319 liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids |
316 where |
320 where |
317 initExpr Nothing = return $ empty |
321 initExpr Nothing = return $ empty |
318 initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) |
322 initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) |
319 |
323 |
320 tvar2C f (OperatorDeclaration op i ret params body) = |
324 tvar2C f (OperatorDeclaration op (Identifier i _) ret params body) = do |
321 tvar2C f (FunctionDeclaration i ret params body) |
325 r <- op2CTyped op (extractTypes params) |
322 |
326 fun2C f i (FunctionDeclaration r ret params body) |
323 |
327 |
|
328 |
|
329 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier |
|
330 op2CTyped op t = do |
|
331 t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t |
|
332 bt <- gets lastType |
|
333 return $ case bt of |
|
334 BTRecord {} -> Identifier (t' ++ "_op_" ++ opStr) bt |
|
335 _ -> Identifier t' bt |
|
336 where |
|
337 opStr = case op of |
|
338 "+" -> "add" |
|
339 "-" -> "sub" |
|
340 "*" -> "mul" |
|
341 "/" -> "div" |
|
342 "=" -> "eq" |
|
343 "<" -> "lt" |
|
344 ">" -> "gt" |
|
345 _ -> error $ "op2CTyped: unknown op '" ++ op ++ "'" |
|
346 |
|
347 extractTypes :: [TypeVarDeclaration] -> [TypeDecl] |
|
348 extractTypes = concatMap f |
|
349 where |
|
350 f (VarDeclaration _ (ids, t) _) = replicate (length ids) t |
|
351 f a = error $ "extractTypes: can't extract from " ++ show a |
|
352 |
324 initExpr2C :: InitExpression -> State RenderState Doc |
353 initExpr2C :: InitExpression -> State RenderState Doc |
325 initExpr2C InitNull = return $ text "NULL" |
354 initExpr2C InitNull = return $ text "NULL" |
326 initExpr2C (InitAddress expr) = liftM ((<>) (text "&")) (initExpr2C expr) |
355 initExpr2C (InitAddress expr) = liftM ((<>) (text "&")) (initExpr2C expr) |
327 initExpr2C (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C expr) |
356 initExpr2C (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C expr) |
328 initExpr2C (InitBinOp op expr1 expr2) = do |
357 initExpr2C (InitBinOp op expr1 expr2) = do |