--- a/tools/pas2c.hs	Thu Apr 05 14:50:58 2012 +0400
+++ b/tools/pas2c.hs	Thu Apr 05 14:58:34 2012 +0400
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 module Pas2C where
 
 import Text.PrettyPrint.HughesPJ
@@ -13,6 +14,7 @@
 import System.IO.Error
 import qualified Data.Map as Map
 import Data.List (find)
+import Numeric
 
 import PascalParser
 import PascalUnitSyntaxTree
@@ -323,6 +325,9 @@
 
     
 initExpr2C :: InitExpression -> State RenderState Doc
+initExpr2C InitNull = return $ text "NULL"
+initExpr2C (InitAddress expr) = liftM ((<>) (text "&")) (initExpr2C expr)
+initExpr2C (InitPrefixOp op expr) = liftM2 (<>) (op2C op) (initExpr2C expr)
 initExpr2C (InitBinOp op expr1 expr2) = do
     e1 <- initExpr2C expr1
     e2 <- initExpr2C expr2
@@ -332,8 +337,16 @@
 initExpr2C (InitFloat s) = return $ text s
 initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
 initExpr2C (InitString s) = return $ doubleQuotes $ text s 
+initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
 initExpr2C (InitReference i) = id2C IOLookup i
-initExpr2C _ = return $ text "<<expression>>"
+initExpr2C (InitRecord fields) = do
+    (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
+    return $ lbrace $+$ (nest 4 . vcat $ fs) $+$ rbrace
+initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
+initExpr2C (InitRange _) = return $ text "<<range expression>>"
+initExpr2C (InitSet _) = return $ text "<<set>>"
+initExpr2C (BuiltInFunction {}) = return $ text "<<built-in function>>"
+initExpr2C a = error $ "Don't know how to render " ++ show a
 
 
 type2C :: TypeDecl -> State RenderState Doc
@@ -350,15 +363,25 @@
     type2C' (PointerTo t) = liftM (<> text "*") $ type2C t
     type2C' (RecordType tvs union) = do
         t <- withState' id $ mapM (tvar2C False) tvs
-        return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}"
+        return $ lbrace $+$ (nest 4 . vcat $ t) $+$ rbrace
     type2C' (RangeType r) = return $ text "<<range type>>"
     type2C' (Sequence ids) = do
         mapM_ (id2C IOInsert) ids
         return $ text "<<sequence type>>"
-    type2C' (ArrayDecl r t) = return $ text "<<array type>>"
+    type2C' (ArrayDecl r t) = do
+        t' <- type2C t
+        return $ t' <> brackets (text "<<range>>")
     type2C' (Set t) = return $ text "<<set>>"
     type2C' (FunctionType returnType params) = return $ text "<<function>>"
-    type2C' (DeriveType _) = return $ text "<<type derived from constant literal>>"
+    type2C' (DeriveType (InitBinOp {})) = return $ text "int"
+    type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i)
+    type2C' (DeriveType (InitNumber _)) = return $ text "int"
+    type2C' (DeriveType (InitHexNumber _)) = return $ text "int"
+    type2C' (DeriveType (InitFloat _)) = return $ text "float"
+    type2C' (DeriveType (BuiltInFunction {})) = return $ text "int"
+    type2C' (DeriveType (InitString {})) = return $ text "string255"
+    type2C' (DeriveType (InitReference {})) = return $ text "<<some type>>"
+    type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
 
 phrase2C :: Phrase -> State RenderState Doc
 phrase2C (Phrases p) = do
@@ -441,22 +464,26 @@
 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
 expr2C (StringLiteral s) = return $ doubleQuotes $ text s 
 expr2C (Reference ref) = ref2C ref
-expr2C (PrefixOp op expr) = liftM2 (<+>) (op2C op) (expr2C expr)
+expr2C (PrefixOp op expr) = liftM2 (<>) (op2C op) (expr2C expr)
 expr2C Null = return $ text "NULL"
 expr2C (BuiltInFunCall params ref) = do
     r <- ref2C ref 
     ps <- mapM expr2C params
     return $ 
         r <> parens (hsep . punctuate (char ',') $ ps)
-expr2C _ = return $ text "<<expression>>"
+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
 
 
 ref2C :: Reference -> State RenderState Doc
 -- rewrite into proper form
-ref2C r@(RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
-ref2C r@(RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2)
-ref2C r@(RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3
-ref2C r@(RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2)
+ref2C (RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
+ref2C (RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2)
+ref2C (RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3
+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
@@ -464,10 +491,6 @@
     t <- gets lastType
     ns <- gets currentScope
     case t of
-         (BTArray _ ta@(BTArray _ t')) 
-            | length exprs == 2 -> modify (\st -> st{lastType = t'})
-            | length exprs == 1 -> modify (\st -> st{lastType = ta})
-            | otherwise -> error $ "Array has more than two dimensions"
          (BTArray _ t') -> modify (\st -> st{lastType = t'})
          (BTString) -> modify (\st -> st{lastType = BTChar})
          a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
@@ -531,5 +554,3 @@
 op2C "=" = return $ text "=="
 op2C a = return $ text a
 
-maybeVoid "" = "void"
-maybeVoid a = a