tools/pas2c.hs
changeset 6895 31def088a870
parent 6894 555a8d8db228
child 6896 23b38e530967
--- a/tools/pas2c.hs	Fri Apr 20 01:50:47 2012 +0400
+++ b/tools/pas2c.hs	Fri Apr 20 22:03:35 2012 +0400
@@ -424,12 +424,12 @@
     where
     type2C' VoidType = return (text "void" <+>)
     type2C' (String l) = return (text ("string" ++ show l) <+>)
-    type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i
+    type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct __" <> i <+> text "*" <+> a) $ id2C IODeferred i
     type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
     type2C' (RecordType tvs union) = do
         t <- withState' id $ mapM (tvar2C False) tvs
         u <- unions
-        return $ \i -> text "struct" <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
+        return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
         where
             unions = case union of
                      Nothing -> return empty
@@ -497,7 +497,7 @@
     cs <- mapM case2C cases
     d <- dflt
     return $ 
-        text "switch" <> parens e <> text "of" $+$ braces (nest 4 . vcat $ cs ++ d)
+        text "switch" <> parens e $+$ braces (nest 4 . vcat $ cs ++ d)
     where
     case2C :: ([InitExpression], Phrase) -> State RenderState Doc
     case2C (e, p) = do
@@ -533,6 +533,13 @@
     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e)
 phrase2C NOP = return $ text ";"
 
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2)
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "inc" BTUnknown))) = liftM (\e -> text "++" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "inc" BTUnknown))) = liftM2 (\a b -> a <+> text "+=" <+> b <> semi) (expr2C e1) (expr2C e2)
+phrase2C a = error $ "phrase2C: " ++ show a
 
 wrapPhrase p@(Phrases _) = p
 wrapPhrase p = Phrases [p]
@@ -547,9 +554,9 @@
         ("+", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction BTString))
         ("==", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction BTBool))
         ("!=", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction BTBool))
-        ("&", BTBool) -> return $ parens $ e1 <+> text "&&" <+> e2
-        ("|", BTBool) -> return $ parens $ e1 <+> text "||" <+> e2
-        (o, _) -> return $ parens $ e1 <+> text o <+> e2
+        ("&", BTBool) -> return $ parens e1 <+> text "&&" <+> parens e2
+        ("|", BTBool) -> return $ parens e1 <+> text "||" <+> parens e2
+        (o, _) -> return $ parens e1 <+> text o <+> parens e2
 expr2C (NumberLiteral s) = return $ text s
 expr2C (FloatLiteral s) = return $ text s
 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
@@ -558,14 +565,16 @@
 expr2C (Reference ref) = ref2C ref
 expr2C (PrefixOp op expr) = liftM (text (op2C op) <>) (expr2C expr)
 expr2C Null = return $ text "NULL"
+expr2C (CharCode a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
+expr2C (HexCharCode a) = return $ quotes $ text "\\x" <> text (map toLower a)
+expr2C (SetExpression ids) = mapM (id2C IOLookup) ids >>= return . parens . hcat . punctuate (text " | ")
+expr2C b@(BuiltInFunCall [e] (SimpleReference (Identifier "ord" _))) = liftM parens $ expr2C e
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "succ" _))) = liftM (<> text " + 1") $ expr2C e
 expr2C (BuiltInFunCall params ref) = do
     r <- ref2C ref 
     ps <- mapM expr2C params
     return $ 
         r <> parens (hsep . punctuate (char ',') $ ps)
-expr2C (CharCode a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
-expr2C (HexCharCode a) = return $ quotes $ text "\\x" <> text (map toLower a)
-expr2C (SetExpression ids) = mapM (id2C IOLookup) ids >>= return . parens . hcat . punctuate (text " | ")
 expr2C a = error $ "Don't know how to render " ++ show a
 
 
@@ -577,8 +586,8 @@
 ref2C (RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2)
 ref2C (ArrayElement (a:b:xs) ref) = ref2C $ ArrayElement (b:xs) (ArrayElement [a] ref)
 -- conversion routines
-ref2C ae@(ArrayElement exprs ref) = do
-    es <- mapM expr2C exprs
+ref2C ae@(ArrayElement [expr] ref) = do
+    e <- expr2C expr
     r <- ref2C ref 
     t <- gets lastType
     ns <- gets currentScope
@@ -591,7 +600,9 @@
                      BTChar -> modify (\st -> st{lastType = BTChar})
                      a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
          a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
-    return $ r <> (brackets . hcat) (punctuate comma es)
+    case t of
+         BTString ->  return $ r <> text ".s" <> brackets e
+         _ -> return $ r <> brackets e
 ref2C (SimpleReference name) = id2C IOLookup name
 ref2C rf@(RecordField (Dereference ref1) ref2) = do
     r1 <- ref2C ref1