tools/pas2c.hs
changeset 7151 ec15d9e1a7e3
parent 7134 beb16926ae5c
child 7265 3f96073156e1
equal deleted inserted replaced
7148:c7ee9592c9a1 7151:ec15d9e1a7e3
   333 resolveType (DeriveType (InitHexNumber _)) = return BTInt
   333 resolveType (DeriveType (InitHexNumber _)) = return BTInt
   334 resolveType (DeriveType (InitNumber _)) = return BTInt
   334 resolveType (DeriveType (InitNumber _)) = return BTInt
   335 resolveType (DeriveType (InitFloat _)) = return BTFloat
   335 resolveType (DeriveType (InitFloat _)) = return BTFloat
   336 resolveType (DeriveType (InitString _)) = return BTString
   336 resolveType (DeriveType (InitString _)) = return BTString
   337 resolveType (DeriveType (InitBinOp {})) = return BTInt
   337 resolveType (DeriveType (InitBinOp {})) = return BTInt
   338 resolveType (DeriveType (InitPrefixOp {})) = return BTInt
   338 resolveType (DeriveType (InitPrefixOp _ e)) = initExpr2C e >> gets lastType
   339 resolveType (DeriveType (BuiltInFunction{})) = return BTInt
   339 resolveType (DeriveType (BuiltInFunction{})) = return BTInt
   340 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
   340 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
   341 resolveType (DeriveType _) = return BTUnknown
   341 resolveType (DeriveType _) = return BTUnknown
   342 resolveType (String _) = return BTString
   342 resolveType (String _) = return BTString
   343 resolveType VoidType = return BTVoid
   343 resolveType VoidType = return BTVoid
   632                     return $ r <+> text "=" <+> e <> semi
   632                     return $ r <+> text "=" <+> e <> semi
   633                 BTString -> do
   633                 BTString -> do
   634                     e <- expr2C expr
   634                     e <- expr2C expr
   635                     return $ r <+> text "=" <+> e <> semi
   635                     return $ r <+> text "=" <+> e <> semi
   636                 _ -> error $ "Assignment to string from " ++ show lt
   636                 _ -> error $ "Assignment to string from " ++ show lt
   637         (BTArray (Range _) _ _, _) -> phrase2C $ 
   637         (BTArray _ _ _, _) -> phrase2C $ 
   638             ProcCall (FunCall
   638             ProcCall (FunCall
   639                 [
   639                 [
   640                 Reference $ Address ref
   640                 Reference $ Address ref
   641                 , Reference $ Address $ RefExpression expr
   641                 , Reference $ Address $ RefExpression expr
   642                 , Reference $ FunCall [expr] (SimpleReference (Identifier "sizeof" BTUnknown))
   642                 , Reference $ FunCall [expr] (SimpleReference (Identifier "sizeof" BTUnknown))
   717     t2 <- gets lastType
   717     t2 <- gets lastType
   718     case (op2C op, t1, t2) of
   718     case (op2C op, t1, t2) of
   719         ("+", 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))
   720         ("+", 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))
   721         ("+", 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))
   722         ("==", 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))
   723         ("==", 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))
   724         ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool))
   725         ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool))
   725         ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
   726         ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
   726         ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
   727         ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
   900         
   901         
   901 ref2C (Address ref) = do
   902 ref2C (Address ref) = do
   902     r <- ref2C ref
   903     r <- ref2C ref
   903     return $ text "&" <> parens r
   904     return $ text "&" <> parens r
   904 ref2C (TypeCast t'@(Identifier i _) expr) = do
   905 ref2C (TypeCast t'@(Identifier i _) expr) = do
   905     case map toLower i of
   906     lt <- expr2C expr >> gets lastType
   906         "pchar" -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
   907     case (map toLower i, lt) of
   907         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
   908             e <- expr2C expr
   911             e <- expr2C expr
   909             t <- id2C IOLookup t'    
   912             t <- id2C IOLookup t'    
   910             return . parens $ parens t <> e
   913             return . parens $ parens t <> e
   911 ref2C (RefExpression expr) = expr2C expr
   914 ref2C (RefExpression expr) = expr2C expr
   912 
   915