960 phrase2C a = error $ "phrase2C: " ++ show a |
960 phrase2C a = error $ "phrase2C: " ++ show a |
961 |
961 |
962 wrapPhrase p@(Phrases _) = p |
962 wrapPhrase p@(Phrases _) = p |
963 wrapPhrase p = Phrases [p] |
963 wrapPhrase p = Phrases [p] |
964 |
964 |
|
965 parensExpr2C :: Expression -> State RenderState Doc |
|
966 parensExpr2C bop@(BinOp _ _ _) = liftM parens $ expr2C bop |
|
967 parensExpr2C set@(SetExpression _ ) = liftM parens $ expr2C set |
|
968 parensExpr2C e = expr2C e |
|
969 |
965 expr2C :: Expression -> State RenderState Doc |
970 expr2C :: Expression -> State RenderState Doc |
966 expr2C (Expression s) = return $ text s |
971 expr2C (Expression s) = return $ text s |
967 expr2C bop@(BinOp op expr1 expr2) = do |
972 expr2C bop@(BinOp op expr1 expr2) = do |
968 e1 <- expr2C expr1 |
973 e1 <- parensExpr2C expr1 |
969 t1 <- gets lastType |
974 t1 <- gets lastType |
970 e2 <- expr2C expr2 |
975 e2 <- parensExpr2C expr2 |
971 t2 <- gets lastType |
976 t2 <- gets lastType |
972 case (op2C op, t1, t2) of |
977 case (op2C op, t1, t2) of |
973 ("+", BTAString, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcatA" (fff t1 t2 BTString)) |
978 ("+", BTAString, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcatA" (fff t1 t2 BTString)) |
974 ("+", BTAString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappendA" (fff t1 t2 BTAString)) |
979 ("+", BTAString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappendA" (fff t1 t2 BTAString)) |
975 ("+", BTChar, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprependA" (fff t1 t2 BTAString)) |
980 ("+", BTChar, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprependA" (fff t1 t2 BTAString)) |
989 ("!=", BTVoid, _) -> procCompare expr1 expr2 "!=" |
994 ("!=", BTVoid, _) -> procCompare expr1 expr2 "!=" |
990 ("!=", BTFunction _ _ _ _, _) -> procCompare expr1 expr2 "!=" |
995 ("!=", BTFunction _ _ _ _, _) -> procCompare expr1 expr2 "!=" |
991 |
996 |
992 ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (fff t1 t2 BTBool)) |
997 ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (fff t1 t2 BTBool)) |
993 ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (fff t1 t2 BTBool)) |
998 ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (fff t1 t2 BTBool)) |
994 ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2 |
999 ("&", BTBool, _) -> return $ e1 <+> text "&&" <+> e2 |
995 ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2 |
1000 ("|", BTBool, _) -> return $ e1 <+> text "||" <+> e2 |
996 (_, BTRecord t1 _, BTRecord t2 _) -> do |
1001 (_, BTRecord t1 _, BTRecord t2 _) -> do |
997 i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier t2 undefined)] |
1002 i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier t2 undefined)] |
998 ref2C $ FunCall [expr1, expr2] (SimpleReference i) |
1003 ref2C $ FunCall [expr1, expr2] (SimpleReference i) |
999 (_, BTRecord t1 _, BTInt _) -> do |
1004 (_, BTRecord t1 _, BTInt _) -> do |
1000 -- aw, "LongInt" here is hwengine-specific hack |
1005 -- aw, "LongInt" here is hwengine-specific hack |
1007 modify(\s -> s{lastType = BTBool}) |
1012 modify(\s -> s{lastType = BTBool}) |
1008 return . parens . hcat . punctuate (text " || ") . map (\i -> parens $ e1 <+> text "==" <+> i) $ ids |
1013 return . parens . hcat . punctuate (text " || ") . map (\i -> parens $ e1 <+> text "==" <+> i) $ ids |
1009 _ -> error "'in' against not set expression" |
1014 _ -> error "'in' against not set expression" |
1010 (o, _, _) | o `elem` boolOps -> do |
1015 (o, _, _) | o `elem` boolOps -> do |
1011 modify(\s -> s{lastType = BTBool}) |
1016 modify(\s -> s{lastType = BTBool}) |
1012 return $ parens e1 <+> text o <+> parens e2 |
1017 return $ e1 <+> text o <+> e2 |
1013 | otherwise -> do |
1018 | otherwise -> do |
1014 o' <- return $ case o of |
1019 o' <- return $ case o of |
1015 "/(float)" -> text "/(float)" -- pascal returns real value |
1020 "/(float)" -> text "/(float)" -- pascal returns real value |
1016 _ -> text o |
1021 _ -> text o |
1017 e1' <- return $ case (o, t1, t2) of |
1022 e1' <- return $ case (o, t1, t2) of |
1018 ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e1 |
1023 ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e1 |
1019 _ -> parens e1 |
1024 _ -> e1 |
1020 e2' <- return $ case (o, t1, t2) of |
1025 e2' <- return $ case (o, t1, t2) of |
1021 ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e2 |
1026 ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e2 |
1022 _ -> parens e2 |
1027 _ -> e2 |
1023 return $ e1' <+> o' <+> e2' |
1028 return $ e1' <+> o' <+> e2' |
1024 where |
1029 where |
1025 fff t1 t2 = BTFunction False False [(False, t1), (False, t2)] |
1030 fff t1 t2 = BTFunction False False [(False, t1), (False, t2)] |
1026 boolOps = ["==", "!=", "<", ">", "<=", ">="] |
1031 boolOps = ["==", "!=", "<", ">", "<=", ">="] |
1027 procCompare expr1 expr2 op = |
1032 procCompare expr1 expr2 op = |
1048 expr2C (Reference ref) = do |
1053 expr2C (Reference ref) = do |
1049 isfunc <- gets isFunctionType |
1054 isfunc <- gets isFunctionType |
1050 modify(\s -> s{isFunctionType = False}) -- reset |
1055 modify(\s -> s{isFunctionType = False}) -- reset |
1051 if isfunc then ref2CF ref False else ref2CF ref True |
1056 if isfunc then ref2CF ref False else ref2CF ref True |
1052 expr2C (PrefixOp op expr) = do |
1057 expr2C (PrefixOp op expr) = do |
1053 e <- expr2C expr |
1058 e <- parensExpr2C expr |
1054 lt <- gets lastType |
1059 lt <- gets lastType |
1055 case lt of |
1060 case lt of |
1056 BTRecord t _ -> do |
1061 BTRecord t _ -> do |
1057 i <- op2CTyped op [SimpleType (Identifier t undefined)] |
1062 i <- op2CTyped op [SimpleType (Identifier t undefined)] |
1058 ref2C $ FunCall [expr] (SimpleReference i) |
1063 ref2C $ FunCall [expr] (SimpleReference i) |
1059 BTBool -> do |
1064 BTBool -> do |
1060 o <- return $ case op of |
1065 o <- return $ case op of |
1061 "not" -> text "!" |
1066 "not" -> text "!" |
1062 _ -> text (op2C op) |
1067 _ -> text (op2C op) |
1063 return $ o <> parens e |
1068 return $ o <> e |
1064 _ -> return $ text (op2C op) <> parens e |
1069 _ -> return $ text (op2C op) <> e |
1065 expr2C Null = return $ text "NULL" |
1070 expr2C Null = return $ text "NULL" |
1066 expr2C (CharCode a) = do |
1071 expr2C (CharCode a) = do |
1067 modify(\s -> s{lastType = BTChar}) |
1072 modify(\s -> s{lastType = BTChar}) |
1068 return $ text "0x" <> text (showHex (read a) "") |
1073 return $ text "0x" <> text (showHex (read a) "") |
1069 expr2C (HexCharCode a) = if length a <= 2 then return $ quotes $ text "\\x" <> text (map toLower a) else expr2C $ HexNumber a |
1074 expr2C (HexCharCode a) = if length a <= 2 then return $ quotes $ text "\\x" <> text (map toLower a) else expr2C $ HexNumber a |