# HG changeset patch
# User unc0rr
# Date 1336679465 -14400
# Node ID de20086a6bcc01312b50063d4195abb6e2c4e054
# Parent  76a9274f280f11d0e3a239e296b627b8d0c99958
Support overloaded operators on (hwFloat op hwFloat) calls

diff -r 76a9274f280f -r de20086a6bcc hedgewars/uFloat.pas
--- a/hedgewars/uFloat.pas	Thu May 10 22:55:13 2012 +0400
+++ b/hedgewars/uFloat.pas	Thu May 10 23:51:05 2012 +0400
@@ -63,6 +63,7 @@
 // The implemented operators
 
 operator = (const z1, z2: hwFloat) z : boolean; inline;
+operator <> (const z1, z2: hwFloat) z : boolean; inline;
 operator + (const z1, z2: hwFloat) z : hwFloat; inline;
 operator - (const z1, z2: hwFloat) z : hwFloat; inline;
 operator - (const z1: hwFloat) z : hwFloat; inline;
@@ -213,6 +214,12 @@
 end;
 
 
+operator <> (const z1, z2: hwFloat) z : boolean; inline;
+begin
+    z:= (z1.isNegative <> z2.isNegative) or (z1.QWordValue <> z2.QWordValue);
+end;
+
+
 operator + (const z1, z2: hwFloat) z : hwFloat;
 begin
 if z1.isNegative = z2.isNegative then
diff -r 76a9274f280f -r de20086a6bcc tools/PascalBasics.hs
--- a/tools/PascalBasics.hs	Thu May 10 22:55:13 2012 +0400
+++ b/tools/PascalBasics.hs	Thu May 10 23:51:05 2012 +0400
@@ -8,7 +8,7 @@
 import Text.Parsec.Language
 import Data.Char
 
-builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break"]
+builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue"]
     
 pascalLanguageDef
     = emptyDef
diff -r 76a9274f280f -r de20086a6bcc tools/PascalUnitSyntaxTree.hs
--- a/tools/PascalUnitSyntaxTree.hs	Thu May 10 22:55:13 2012 +0400
+++ b/tools/PascalUnitSyntaxTree.hs	Thu May 10 23:51:05 2012 +0400
@@ -103,7 +103,7 @@
     | BTInt
     | BTBool
     | BTFloat
-    | BTRecord [(String, BaseType)]
+    | BTRecord String [(String, BaseType)]
     | BTArray Range BaseType BaseType
     | BTFunction Int BaseType
     | BTPointerTo BaseType
diff -r 76a9274f280f -r de20086a6bcc tools/pas2c.hs
--- a/tools/pas2c.hs	Thu May 10 22:55:13 2012 +0400
+++ b/tools/pas2c.hs	Thu May 10 23:51:05 2012 +0400
@@ -24,10 +24,12 @@
 data InsertOption = 
     IOInsert
     | IOLookup
+    | IOLookupLast
     | IOLookupFunction Int
     | IODeferred
 
-type Records = Map.Map String [(String, BaseType)]
+type Record = (String, BaseType)
+type Records = Map.Map String [Record]
 data RenderState = RenderState 
     {
         currentScope :: Records,
@@ -246,14 +248,8 @@
     return $ text i'
     where
         n = map toLower i
-id2C IOLookup (Identifier i t) = do
-    let i' = map toLower i
-    v <- gets $ Map.lookup i' . currentScope
-    lt <- gets lastType
-    if isNothing v then 
-        error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt
-        else 
-        let vv = head $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
+id2C IOLookup i = id2CLookup head i
+id2C IOLookupLast i = id2CLookup last i
 id2C (IOLookupFunction params) (Identifier i t) = do
     let i' = map toLower i
     v <- gets $ Map.lookup i' . currentScope
@@ -274,14 +270,31 @@
         else
         let vv = head $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
 
+id2CLookup :: ([Record] -> Record) -> Identifier -> State RenderState Doc
+id2CLookup f (Identifier i _) = do
+    let i' = map toLower i
+    v <- gets $ Map.lookup i' . currentScope
+    lt <- gets lastType
+    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)
+        
+        
 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
 id2CTyped t (Identifier i _) = do
     tb <- resolveType t
-    case tb of 
-        BTUnknown -> do
+    case (t, tb) of 
+        (_, BTUnknown) -> do
             error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t
-        _ -> return ()
-    id2C IOInsert (Identifier i tb)
+        (SimpleType {}, BTRecord _ r) -> do
+            ts <- type2C t
+            id2C IOInsert (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)
+    
 
 
 resolveType :: TypeDecl -> State RenderState BaseType
@@ -301,7 +314,7 @@
 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
 resolveType (RecordType tv mtvs) = do
     tvs <- mapM f (concat $ tv : fromMaybe [] mtvs)
-    return . BTRecord . concat $ tvs
+    return . BTRecord "" . concat $ tvs
     where
         f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
         f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
@@ -420,9 +433,7 @@
 op2CTyped op t = do
     t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t
     bt <- gets lastType
-    return $ case bt of
-         BTRecord {} -> Identifier (t' ++ "_op_" ++ opStr) bt
-         _ -> Identifier t' bt
+    return $ Identifier (t' ++ "_op_" ++ opStr) bt
     where 
     opStr = case op of
                     "+" -> "add"
@@ -432,6 +443,7 @@
                     "=" -> "eq"
                     "<" -> "lt"
                     ">" -> "gt"
+                    "<>" -> "neq"
                     _ -> error $ "op2CTyped: unknown op '" ++ op ++ "'"
     
 extractTypes :: [TypeVarDeclaration] -> [TypeDecl]
@@ -519,7 +531,7 @@
         i' <- id2C IODeferred i
         lt <- gets lastType
         case lt of
-             BTRecord _ -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
+             BTRecord _ _ -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
              BTUnknown -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
              _ -> return $ \a -> i' <+> text "*" <+> a
     type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
@@ -618,7 +630,7 @@
     r <- ref2C ref 
     t <- gets lastType
     case t of
-        (BTRecord rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p
+        (BTRecord _ rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p
         a -> do
             error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb
 phrase2C (ForCycle i' e1' e2' p) = do
@@ -638,6 +650,7 @@
 
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> 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)
@@ -663,13 +676,18 @@
         ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool))
         ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
         ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
+        (_, BTRecord t1 _, BTRecord t2 _) -> do
+            i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier t2 undefined)]
+            ref2C $ FunCall [expr1, expr2] (SimpleReference i)
         (o, _, _) | o `elem` boolOps -> do
                         modify(\s -> s{lastType = BTBool})
                         return $ parens e1 <+> text o <+> parens e2
                   | otherwise -> return $ parens e1 <+> text o <+> parens e2
     where
         boolOps = ["==", "!=", "<", ">", "<=", ">="]
-expr2C (NumberLiteral s) = return $ text s
+expr2C (NumberLiteral s) = do
+    modify(\s -> s{lastType = BTInt})
+    return $ text s
 expr2C (FloatLiteral s) = return $ text s
 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
 expr2C (StringLiteral [a]) = do
@@ -677,7 +695,14 @@
     return . quotes $ text [a]
 expr2C (StringLiteral s) = addStringConst s
 expr2C (Reference ref) = ref2CF ref
-expr2C (PrefixOp op expr) = liftM (text (op2C op) <>) (expr2C expr)
+expr2C (PrefixOp op expr) = do
+    e <- expr2C expr
+    lt <- gets lastType
+    case lt of
+        BTRecord t _ -> do
+            i <- op2CTyped op [SimpleType (Identifier t undefined)]
+            ref2C $ FunCall [expr] (SimpleReference i)
+        _ -> return $ text (op2C op) <> e
 expr2C Null = return $ text "NULL"
 expr2C (CharCode a) = do
     modify(\s -> s{lastType = BTChar})
@@ -759,7 +784,7 @@
     r1 <- ref2C ref1 
     t <- fromPointer (show ref1) =<< gets lastType
     r2 <- case t of
-        BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2
+        BTRecord _ rs -> withRecordNamespace "" rs $ ref2C ref2
         BTUnit -> withLastIdNamespace $ ref2CF ref2
         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
     return $ 
@@ -768,7 +793,7 @@
     r1 <- ref2C ref1
     t <- gets lastType
     case t of
-        BTRecord rs -> do
+        BTRecord _ rs -> do
             r2 <- withRecordNamespace "" rs $ ref2C ref2
             return $ r1 <> text "." <> r2
         BTUnit -> withLastIdNamespace $ ref2CF ref2