37 lastType :: BaseType, |
37 lastType :: BaseType, |
38 stringConsts :: [(String, String)], |
38 stringConsts :: [(String, String)], |
39 uniqCounter :: Int, |
39 uniqCounter :: Int, |
40 toMangle :: Set.Set String, |
40 toMangle :: Set.Set String, |
41 currentUnit :: String, |
41 currentUnit :: String, |
|
42 currentFunctionResult :: String, |
42 namespaces :: Map.Map String Records |
43 namespaces :: Map.Map String Records |
43 } |
44 } |
44 |
45 |
45 emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" |
46 emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" "" |
46 |
47 |
47 getUniq :: State RenderState Int |
48 getUniq :: State RenderState Int |
48 getUniq = do |
49 getUniq = do |
49 i <- gets uniqCounter |
50 i <- gets uniqCounter |
50 modify(\s -> s{uniqCounter = uniqCounter s + 1}) |
51 modify(\s -> s{uniqCounter = uniqCounter s + 1}) |
332 resolveType (DeriveType (InitHexNumber _)) = return BTInt |
333 resolveType (DeriveType (InitHexNumber _)) = return BTInt |
333 resolveType (DeriveType (InitNumber _)) = return BTInt |
334 resolveType (DeriveType (InitNumber _)) = return BTInt |
334 resolveType (DeriveType (InitFloat _)) = return BTFloat |
335 resolveType (DeriveType (InitFloat _)) = return BTFloat |
335 resolveType (DeriveType (InitString _)) = return BTString |
336 resolveType (DeriveType (InitString _)) = return BTString |
336 resolveType (DeriveType (InitBinOp {})) = return BTInt |
337 resolveType (DeriveType (InitBinOp {})) = return BTInt |
337 resolveType (DeriveType (InitPrefixOp {})) = return BTInt |
338 resolveType (DeriveType (InitPrefixOp _ e)) = initExpr2C e >> gets lastType |
338 resolveType (DeriveType (BuiltInFunction{})) = return BTInt |
339 resolveType (DeriveType (BuiltInFunction{})) = return BTInt |
339 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type |
340 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type |
340 resolveType (DeriveType _) = return BTUnknown |
341 resolveType (DeriveType _) = return BTUnknown |
341 resolveType (String _) = return BTString |
342 resolveType (String _) = return BTString |
342 resolveType VoidType = return BTVoid |
343 resolveType VoidType = return BTVoid |
379 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
380 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
380 let res = docToLower $ text rv <> text "_result" |
381 let res = docToLower $ text rv <> text "_result" |
381 t <- type2C returnType |
382 t <- type2C returnType |
382 t'<- gets lastType |
383 t'<- gets lastType |
383 n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name |
384 n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name |
384 (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st}) $ do |
385 |
|
386 let isVoid = case returnType of |
|
387 VoidType -> True |
|
388 _ -> False |
|
389 |
|
390 (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st |
|
391 , currentFunctionResult = if isVoid then [] else render res}) $ do |
385 p <- functionParams2C params |
392 p <- functionParams2C params |
386 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
393 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
387 return (p, ph) |
394 return (p, ph) |
388 let phrasesBlock = case returnType of |
395 |
389 VoidType -> ph |
396 let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
390 _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi |
397 |
391 return [ |
398 return [ |
392 t empty <+> n <> parens p |
399 t empty <+> n <> parens p |
393 $+$ |
400 $+$ |
394 text "{" |
401 text "{" |
395 $+$ |
402 $+$ |
613 t <- gets lastType |
620 t <- gets lastType |
614 case (t, expr) of |
621 case (t, expr) of |
615 (BTFunction {}, (Reference r')) -> do |
622 (BTFunction {}, (Reference r')) -> do |
616 e <- ref2C r' |
623 e <- ref2C r' |
617 return $ r <+> text "=" <+> e <> semi |
624 return $ r <+> text "=" <+> e <> semi |
618 (BTArray (Range _) _ _, _) -> phrase2C $ |
625 (BTString, _) -> do |
|
626 e <- expr2C expr |
|
627 lt <- gets lastType |
|
628 case lt of |
|
629 -- assume pointer to char for simplicity |
|
630 BTPointerTo _ -> do |
|
631 e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown)) |
|
632 return $ r <+> text "=" <+> e <> semi |
|
633 BTString -> do |
|
634 e <- expr2C expr |
|
635 return $ r <+> text "=" <+> e <> semi |
|
636 _ -> error $ "Assignment to string from " ++ show lt |
|
637 (BTArray _ _ _, _) -> phrase2C $ |
619 ProcCall (FunCall |
638 ProcCall (FunCall |
620 [ |
639 [ |
621 Reference $ Address ref |
640 Reference $ Address ref |
622 , Reference $ Address $ RefExpression expr |
641 , Reference $ Address $ RefExpression expr |
623 , Reference $ FunCall [expr] (SimpleReference (Identifier "sizeof" BTUnknown)) |
642 , Reference $ FunCall [expr] (SimpleReference (Identifier "sizeof" BTUnknown)) |
669 e <- expr2C e' |
688 e <- expr2C e' |
670 p <- phrase2C (Phrases p') |
689 p <- phrase2C (Phrases p') |
671 return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi |
690 return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi |
672 phrase2C NOP = return $ text ";" |
691 phrase2C NOP = return $ text ";" |
673 |
692 |
674 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi |
693 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do |
|
694 f <- gets currentFunctionResult |
|
695 if null f then |
|
696 return $ text "return" <> semi |
|
697 else |
|
698 return $ text "return" <+> text f <> semi |
675 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi |
699 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi |
676 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi |
700 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi |
677 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e |
701 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e |
678 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e |
702 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e |
679 phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2) |
703 phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2) |
693 t2 <- gets lastType |
717 t2 <- gets lastType |
694 case (op2C op, t1, t2) of |
718 case (op2C op, t1, t2) of |
695 ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction 2 BTString)) |
719 ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction 2 BTString)) |
696 ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction 2 BTString)) |
720 ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction 2 BTString)) |
697 ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction 2 BTString)) |
721 ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction 2 BTString)) |
|
722 ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction 2 BTString)) |
698 ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction 2 BTBool)) |
723 ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction 2 BTBool)) |
699 ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction 2 BTBool)) |
724 ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction 2 BTBool)) |
700 ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool)) |
725 ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool)) |
701 ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2 |
726 ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2 |
702 ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2 |
727 ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2 |
876 |
901 |
877 ref2C (Address ref) = do |
902 ref2C (Address ref) = do |
878 r <- ref2C ref |
903 r <- ref2C ref |
879 return $ text "&" <> parens r |
904 return $ text "&" <> parens r |
880 ref2C (TypeCast t'@(Identifier i _) expr) = do |
905 ref2C (TypeCast t'@(Identifier i _) expr) = do |
881 case map toLower i of |
906 lt <- expr2C expr >> gets lastType |
882 "pchar" -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar)) |
907 case (map toLower i, lt) of |
883 a -> do |
908 ("pchar", BTString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar)) |
|
909 ("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString)) |
|
910 (a, _) -> do |
884 e <- expr2C expr |
911 e <- expr2C expr |
885 t <- id2C IOLookup t' |
912 t <- id2C IOLookup t' |
886 return . parens $ parens t <> e |
913 return . parens $ parens t <> e |
887 ref2C (RefExpression expr) = expr2C expr |
914 ref2C (RefExpression expr) = expr2C expr |
888 |
915 |