# HG changeset patch
# User unc0rr
# Date 1333461213 -14400
# Node ID affeaba0af71814d6285d8a44bcee42b2d292d07
# Parent  3328ad73af25db993136c563693a0443b26b7ee3
Fix withState' not returning lastType

diff -r 3328ad73af25 -r affeaba0af71 hedgewars/pas2cSystem.pas
--- a/hedgewars/pas2cSystem.pas	Tue Apr 03 10:08:35 2012 +0100
+++ b/hedgewars/pas2cSystem.pas	Tue Apr 03 17:53:33 2012 +0400
@@ -64,8 +64,13 @@
 
     assign, rewrite, reset, flush, BlockWrite, close : procedure;
     IOResult : function : integer;
-    exit, break, halt : procedure;
+    exit, break, halt, continue : procedure;
     TextFile, file : Handle;
+    FileMode : integer;
+    eof : function : boolean;
+    
+    ParamCount : function : integer;
+    ParamStr : function : string;
 
     Sqrt, ArcTan2, pi, cos, sin : function : float;
 
@@ -89,3 +94,8 @@
     gldeletetextures, glreadpixels : procedure;
 
     TThreadId : function : integer;
+    ThreadSwitch : procedure;
+    
+    random : function : integer;
+    
+    Assigned : function : boolean;
diff -r 3328ad73af25 -r affeaba0af71 tools/pas2c.hs
--- a/tools/pas2c.hs	Tue Apr 03 10:08:35 2012 +0100
+++ b/tools/pas2c.hs	Tue Apr 03 17:53:33 2012 +0400
@@ -77,7 +77,7 @@
     let u = Map.toList units
     let nss = Map.map (toNamespace nss) units
     hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . null) $ nss)
-    writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
+    --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
     mapM_ (toCFiles nss) u
     where
     toNamespace :: Map.Map String [Record] -> PascalUnit -> [Record]
@@ -88,10 +88,12 @@
         currentScope $ execState (interface2C interface) (emptyState nss)
 
 
-withState' :: (a -> a) -> State a b -> State a b
-withState' f s = do
+withState' :: (RenderState -> RenderState) -> State RenderState a -> State RenderState a
+withState' f sf = do
     st <- liftM f get
-    return $ evalState s st
+    let (a, s) = runState sf st
+    modify(\st -> st{lastType = lastType s})
+    return a
 
 withLastIdNamespace :: State RenderState Doc -> State RenderState Doc
 withLastIdNamespace f = do
@@ -100,6 +102,7 @@
     withState' (\st -> st{currentScope = fromMaybe [] $ Map.lookup li (namespaces st)}) f
 
 withRecordNamespace :: [(String, BaseType)] -> State RenderState Doc -> State RenderState Doc
+withRecordNamespace [] = error "withRecordNamespace: empty record"
 withRecordNamespace recs = withState' f
     where
         f st = st{currentScope = records ++ currentScope st}
@@ -183,8 +186,9 @@
     let i' = map toLower i
     v <- gets $ find (\(a, _) -> a == i') . currentScope
     ns <- gets currentScope
+    lt <- gets lastType
     if isNothing v then 
-        error $ "Not defined: '" ++ i' ++ "'\n" ++ show (take 100 ns)
+        error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt ++ "\n" ++ show (take 100 ns)
         else 
         let vv = snd $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
 id2C IODeferred (Identifier i t) = do
@@ -455,7 +459,8 @@
     case t of
          (BTArray _ ta@(BTArray _ t')) 
             | length exprs == 2 -> modify (\st -> st{lastType = t'})
-            | otherwise -> modify (\st -> st{lastType = ta})
+            | 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)