245 id2C :: InsertOption -> Identifier -> State RenderState Doc |
245 id2C :: InsertOption -> Identifier -> State RenderState Doc |
246 id2C IOInsert (Identifier i t) = do |
246 id2C IOInsert (Identifier i t) = do |
247 ns <- gets currentScope |
247 ns <- gets currentScope |
248 tom <- gets (Set.member n . toMangle) |
248 tom <- gets (Set.member n . toMangle) |
249 cu <- gets currentUnit |
249 cu <- gets currentUnit |
250 let i' = case (t, tom) of |
250 let (i', t') = case (t, tom) of |
251 (BTFunction p _, True) -> cu ++ i ++ ('_' : show p) |
251 (BTFunction p _, True) -> (cu ++ i ++ ('_' : show p), t) |
252 (BTFunction _ _, _) -> cu ++ i |
252 (BTFunction _ _, _) -> (cu ++ i, t) |
253 _ -> i |
253 (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t') |
254 modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t)] (currentScope s), lastIdentifier = n}) |
254 _ -> (i, t) |
|
255 modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t')] (currentScope s), lastIdentifier = n}) |
255 return $ text i' |
256 return $ text i' |
256 where |
257 where |
257 n = map toLower i |
258 n = map toLower i |
258 id2C IOLookup i = id2CLookup head i |
259 id2C IOLookup i = id2CLookup head i |
259 id2C IOLookupLast i = id2CLookup last i |
260 id2C IOLookupLast i = id2CLookup last i |
342 resolveType (String _) = return BTString |
343 resolveType (String _) = return BTString |
343 resolveType VoidType = return BTVoid |
344 resolveType VoidType = return BTVoid |
344 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
345 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
345 resolveType (RangeType _) = return $ BTVoid |
346 resolveType (RangeType _) = return $ BTVoid |
346 resolveType (Set t) = liftM BTSet $ resolveType t |
347 resolveType (Set t) = liftM BTSet $ resolveType t |
|
348 resolveType (VarParamType t) = liftM BTVarParam $ resolveType t |
347 |
349 |
348 |
350 |
349 resolve :: String -> BaseType -> State RenderState BaseType |
351 resolve :: String -> BaseType -> State RenderState BaseType |
350 resolve s (BTUnresolved t) = do |
352 resolve s (BTUnresolved t) = do |
351 v <- gets $ Map.lookup t . currentScope |
353 v <- gets $ Map.lookup t . currentScope |
373 hasPassByReference = or . map isVar |
375 hasPassByReference = or . map isVar |
374 where |
376 where |
375 isVar (VarDeclaration v _ (_, _) _) = v |
377 isVar (VarDeclaration v _ (_, _) _) = v |
376 isVar _ = error $ "hasPassByReference called not on function parameters" |
378 isVar _ = error $ "hasPassByReference called not on function parameters" |
377 |
379 |
|
380 toIsVarList :: [TypeVarDeclaration] -> [Bool] |
|
381 toIsVarList = concatMap isVar |
|
382 where |
|
383 isVar (VarDeclaration v _ (p, _) _) = replicate (length p) v |
|
384 isVar _ = error $ "toIsVarList called not on function parameters" |
|
385 |
|
386 |
|
387 funWithVarsToDefine :: String -> [TypeVarDeclaration] -> Doc |
|
388 funWithVarsToDefine n params = text "#define" <+> text n <> parens abc <+> text (n ++ "__vars") <> parens cparams |
|
389 where |
|
390 abc = hcat . punctuate comma . map (char . fst) $ ps |
|
391 cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps |
|
392 ps = zip ['a'..] (toIsVarList params) |
|
393 |
378 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] |
394 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] |
379 fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do |
395 fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do |
380 t <- type2C returnType |
396 t <- type2C returnType |
381 t'<- gets lastType |
397 t'<- gets lastType |
382 p <- withState' id $ functionParams2C params |
398 p <- withState' id $ functionParams2C params |
383 n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name |
399 n <- liftM render . id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name |
384 return [t empty <+> n <> parens p] |
400 if hasPassByReference params then |
385 |
401 return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p] |
386 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
402 else |
|
403 return [t empty <+> text n <> parens p] |
|
404 |
|
405 |
|
406 fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do |
387 let res = docToLower $ text rv <> text "_result" |
407 let res = docToLower $ text rv <> text "_result" |
388 t <- type2C returnType |
408 t <- type2C returnType |
389 t'<- gets lastType |
409 t'<- gets lastType |
390 n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name |
410 |
|
411 notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope |
|
412 |
|
413 n <- liftM render . id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name |
391 |
414 |
392 let isVoid = case returnType of |
415 let isVoid = case returnType of |
393 VoidType -> True |
416 VoidType -> True |
394 _ -> False |
417 _ -> False |
395 |
418 |
422 fun2C b name f |
445 fun2C b name f |
423 tvar2C _ td@(TypeDeclaration i' t) = do |
446 tvar2C _ td@(TypeDeclaration i' t) = do |
424 i <- id2CTyped t i' |
447 i <- id2CTyped t i' |
425 tp <- type2C t |
448 tp <- type2C t |
426 return [text "typedef" <+> tp i] |
449 return [text "typedef" <+> tp i] |
|
450 |
|
451 tvar2C _ (VarDeclaration True _ (ids, t) Nothing) = do |
|
452 t' <- liftM ((empty <+>) . ) $ type2C t |
|
453 liftM (map(\i -> t' i)) $ mapM (id2CTyped (VarParamType t)) ids |
427 |
454 |
428 tvar2C _ (VarDeclaration _ isConst (ids, t) mInitExpr) = do |
455 tvar2C _ (VarDeclaration _ isConst (ids, t) mInitExpr) = do |
429 t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t |
456 t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t |
430 ie <- initExpr mInitExpr |
457 ie <- initExpr mInitExpr |
431 lt <- gets lastType |
458 lt <- gets lastType |