--- a/tools/pas2c.hs	Sat Aug 18 00:47:51 2012 +0200
+++ b/tools/pas2c.hs	Sat Aug 18 00:48:09 2012 +0200
@@ -17,24 +17,32 @@
 import Data.List (find)
 import Numeric
 
-import PascalParser
+import PascalParser(pascalUnit)
 import PascalUnitSyntaxTree
 
 
 data InsertOption =
     IOInsert
+    | IOInsertWithType Doc
     | IOLookup
     | IOLookupLast
     | IOLookupFunction Int
     | IODeferred
 
-type Record = (String, BaseType)
+data Record = Record
+    {
+        lcaseId :: String,
+        baseType :: BaseType,
+        typeDecl :: Doc
+    }
+    deriving Show
 type Records = Map.Map String [Record]
 data RenderState = RenderState
     {
         currentScope :: Records,
         lastIdentifier :: String,
         lastType :: BaseType,
+        lastIdTypeDecl :: Doc,
         stringConsts :: [(String, String)],
         uniqCounter :: Int,
         toMangle :: Set.Set String,
@@ -43,7 +51,9 @@
         namespaces :: Map.Map String Records
     }
 
-emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" ""
+rec2Records = map (\(a, b) -> Record a b empty)
+
+emptyState = RenderState Map.empty "" BTUnknown empty [] 0 Set.empty "" ""
 
 getUniq :: State RenderState Int
 getUniq = do
@@ -161,12 +171,12 @@
     nss <- gets namespaces
     withState' (\st -> st{currentScope = fromMaybe Map.empty $ Map.lookup li (namespaces st)}) f
 
-withRecordNamespace :: String -> [(String, BaseType)] -> State RenderState Doc -> State RenderState Doc
+withRecordNamespace :: String -> [Record] -> State RenderState Doc -> State RenderState Doc
 withRecordNamespace _ [] = error "withRecordNamespace: empty record"
 withRecordNamespace prefix recs = withState' f
     where
         f st = st{currentScope = Map.unionWith un records (currentScope st), currentUnit = ""}
-        records = Map.fromList $ map (\(a, b) -> (map toLower a, [(prefix ++ a, b)])) recs
+        records = Map.fromList $ map (\(Record a b d) -> (map toLower a, [Record (prefix ++ a) b d])) recs
         un [a] b = a : b
 
 toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO ()
@@ -200,7 +210,7 @@
 
 pascal2C (Program _ implementation mainFunction) = do
     impl <- implementation2C implementation
-    [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction)))
+    [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) False (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction)))
     return $ impl $+$ main
 
 
@@ -231,7 +241,7 @@
     where
         initMap = Map.empty
         --initMap = Map.fromList [("reset", 2)]
-        ins (FunctionDeclaration (Identifier i _) _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
+        ins (FunctionDeclaration (Identifier i _) _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
         ins _ m = m
 
 -- the second bool indicates whether declare variable as extern or not
@@ -261,8 +271,11 @@
 uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
 
 
+setLastIdValues vv = (\s -> s{lastType = baseType vv, lastIdentifier = lcaseId vv, lastIdTypeDecl = typeDecl vv})
+
 id2C :: InsertOption -> Identifier -> State RenderState Doc
-id2C IOInsert (Identifier i t) = do
+id2C IOInsert i = id2C (IOInsertWithType empty) i
+id2C (IOInsertWithType d) (Identifier i t) = do
     ns <- gets currentScope
     tom <- gets (Set.member n . toMangle)
     cu <- gets currentUnit
@@ -271,7 +284,7 @@
             (BTFunction _ _ _, _) -> (cu ++ i, t)
             (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t')
             _ -> (i, t)
-    modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t')] (currentScope s), lastIdentifier = n})
+    modify (\s -> s{currentScope = Map.insertWith (++) n [Record i' t' d] (currentScope s), lastIdentifier = n})
     return $ text i'
     where
         n = map toLower i
@@ -286,9 +299,9 @@
         error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt ++ "\nwith num of params = " ++ show params ++ "\n" ++ show v
         else
         let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in
-            modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
+            modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
     where
-        checkParam (_, BTFunction _ p _) = p == params
+        checkParam (Record _ (BTFunction _ p _) _) = p == params
         checkParam _ = False
 id2C IODeferred (Identifier i t) = do
     let i' = map toLower i
@@ -296,7 +309,7 @@
     if (isNothing v) then
         modify (\s -> s{lastType = BTUnknown, lastIdentifier = i}) >> return (text i)
         else
-        let vv = head $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
+        let vv = head $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
 
 id2CLookup :: ([Record] -> Record) -> Identifier -> State RenderState Doc
 id2CLookup f (Identifier i t) = do
@@ -306,30 +319,34 @@
     if isNothing v then
         error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt
         else
-        let vv = f $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
+        let vv = f $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
 
 
 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
-id2CTyped t (Identifier i _) = do
+id2CTyped = id2CTyped2 Nothing
+
+id2CTyped2 :: Maybe Doc -> TypeDecl -> Identifier -> State RenderState Doc
+id2CTyped2 md t (Identifier i _) = do
     tb <- resolveType t
     case (t, tb) of
         (_, BTUnknown) -> do
             error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t
         (SimpleType {}, BTRecord _ r) -> do
             ts <- type2C t
-            id2C IOInsert (Identifier i (BTRecord (render $ ts empty) r))
+            id2C (IOInsertWithType $ ts empty) (Identifier i (BTRecord (render $ ts empty) r))
         (_, BTRecord _ r) -> do
             ts <- type2C t
-            id2C IOInsert (Identifier i (BTRecord i r))
-        _ -> id2C IOInsert (Identifier i tb)
-
+            id2C (IOInsertWithType $ ts empty) (Identifier i (BTRecord i r))
+        _ -> case md of
+                Nothing -> id2C IOInsert (Identifier i tb)
+                Just ts -> id2C (IOInsertWithType ts) (Identifier i tb)
 
 
 resolveType :: TypeDecl -> State RenderState BaseType
 resolveType st@(SimpleType (Identifier i _)) = do
     let i' = map toLower i
     v <- gets $ Map.lookup i' . currentScope
-    if isJust v then return . snd . head $ fromJust v else return $ f i'
+    if isJust v then return . baseType . head $ fromJust v else return $ f i'
     where
     f "integer" = BTInt
     f "pointer" = BTPointerTo BTVoid
@@ -372,7 +389,7 @@
 resolve s (BTUnresolved t) = do
     v <- gets $ Map.lookup t . currentScope
     if isJust v then
-        resolve s . snd . head . fromJust $ v
+        resolve s . baseType . head . fromJust $ v
         else
         error $ "Unknown type " ++ show t ++ "\n" ++ s
 resolve _ t = return t
@@ -412,20 +429,21 @@
         ps = zip ['a'..] (toIsVarList params)
 
 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
-fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do
+fun2C _ _ (FunctionDeclaration name inline returnType params Nothing) = do
     t <- type2C returnType
     t'<- gets lastType
     p <- withState' id $ functionParams2C params
     n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name
+    let decor = if inline then text "inline" else empty
     if hasVars then
-        return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p]
+        return [funWithVarsToDefine n params $+$ decor <+> t empty <+> text (n ++ "__vars") <> parens p]
         else
-        return [t empty <+> text n <> parens p]
+        return [decor <+> t empty <+> text n <> parens p]
     where
         hasVars = hasPassByReference params
 
 
-fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do
+fun2C True rv (FunctionDeclaration name@(Identifier i _) inline returnType params (Just (tvars, phrase))) = do
     let res = docToLower $ text rv <> text "_result"
     t <- type2C returnType
     t'<- gets lastType
@@ -438,7 +456,7 @@
             VoidType -> True
             _ -> False
 
-    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st
+    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record (render res) t' empty] $ currentScope st
             , currentFunctionResult = if isVoid then [] else render res}) $ do
         p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase)
@@ -446,11 +464,12 @@
 
     let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
     let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty
+    let decor = if inline then text "inline" else empty
     return [
         define
         $+$
         --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$
-        t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p
+        decor <+> t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p
         $+$
         text "{"
         $+$
@@ -463,14 +482,14 @@
     un [a] b = a : b
     hasVars = hasPassByReference params
 
-fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
+fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _) = error $ "nested functions not allowed: " ++ name
 fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv
 
 -- the second bool indicates whether declare variable as extern or not
 -- the third bool indicates whether include types or not
 -- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params)
 tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc]
-tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _) = do
+tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _) = do
     t <- fun2C b name f
     if includeType then return t else return []
 tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do
@@ -480,7 +499,7 @@
 
 tvar2C _ _ _ _ (VarDeclaration True _ (ids, t) Nothing) = do
     t' <- liftM ((empty <+>) . ) $ type2C t
-    liftM (map(\i -> t' i)) $ mapM (id2CTyped (VarParamType t)) ids
+    liftM (map(\i -> t' i)) $ mapM (id2CTyped2 (Just $ t' empty) (VarParamType t)) ids
 
 tvar2C _ externVar includeType ignoreInit (VarDeclaration _ isConst (ids, t) mInitExpr) = do
     t' <- liftM (((if isConst then text "static const" else if externVar 
@@ -515,7 +534,7 @@
                     
                 (_, _) -> return result
             
-         _ -> liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie)) $ mapM (id2CTyped t) ids
+         _ -> liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie)) $ mapM (id2CTyped2 (Just $ t' empty) t) ids
     where
     initExpr Nothing = return $ empty
     initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e)
@@ -528,9 +547,9 @@
         ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported."
         _ -> 0
 
-tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) ret params body) = do
+tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do
     r <- op2CTyped op (extractTypes params)
-    fun2C f i (FunctionDeclaration r ret params body)
+    fun2C f i (FunctionDeclaration r inline ret params body)
 
 
 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier
@@ -780,20 +799,27 @@
     r <- ref2C ref
     t <- gets lastType
     case t of
-        (BTRecord _ rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p
+        (BTRecord _ rs) -> withRecordNamespace (render r ++ ".") (rec2Records rs) $ phrase2C $ wrapPhrase p
         a -> do
             error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb
 phrase2C (ForCycle i' e1' e2' p up) = do
     i <- id2C IOLookup i'
+    iType <- gets lastIdTypeDecl
     e1 <- expr2C e1'
     e2 <- expr2C e2'
-    ph <- phrase2C (wrapPhrase p)
-    cmp <- return $ if up == True then "<=" else ">="
-    inc <- return $ if up == True then "++" else "--"
-    return $
-        text "for" <> (parens . hsep . punctuate (char ';') $ [i <+> text "=" <+> parens e1, i <+> text cmp <+> parens e2, text inc <> i])
+    let inc = if up then "inc" else "dec"
+    let add = if up then "+ 1" else "- 1"
+    let iEnd = i <> text "__end__"
+    ph <- phrase2C . appendPhrase (BuiltInFunctionCall [Reference $ SimpleReference i'] (SimpleReference (Identifier inc BTUnknown))) $ wrapPhrase p
+    return . braces $
+        i <+> text "=" <+> e1 <> semi
         $$
-        ph
+        iType <+> iEnd <+> text "=" <+> e2 <> semi
+        $$ 
+        text "if" <+> (parens $ i <+> text "<=" <+> iEnd) <+> text "do" <+> ph <+>
+        text "while" <> parens (i <+> text "!=" <+> iEnd <+> text add) <> semi
+    where
+        appendPhrase p (Phrases ps) = Phrases $ ps ++ [p]
 phrase2C (RepeatCycle e' p') = do
     e <- expr2C e'
     p <- phrase2C (Phrases p')
@@ -992,7 +1018,7 @@
     r1 <- ref2C ref1
     t <- fromPointer (show ref1) =<< gets lastType
     r2 <- case t of
-        BTRecord _ rs -> withRecordNamespace "" rs $ ref2C ref2
+        BTRecord _ rs -> withRecordNamespace "" (rec2Records rs) $ ref2C ref2
         BTUnit -> error "What??"
         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
     return $
@@ -1002,7 +1028,7 @@
     t <- gets lastType
     case t of
         BTRecord _ rs -> do
-            r2 <- withRecordNamespace "" rs $ ref2C ref2
+            r2 <- withRecordNamespace "" (rec2Records rs) $ ref2C ref2
             return $ r1 <> text "." <> r2
         BTUnit -> withLastIdNamespace $ ref2C ref2
         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf