--- a/gameServer/Actions.hs Mon Aug 06 00:44:32 2012 +0400
+++ b/gameServer/Actions.hs Thu Aug 09 01:01:06 2012 +0400
@@ -221,7 +221,7 @@
chans <- othersChans
if master then
- if gameProgress && playersNum > 1 then
+ if playersNum > 1 then
mapM_ processAction [ChangeMaster, NoticeMessage AdminLeft, RemoveClientTeams ci, AnswerClients chans ["LEFT", clNick, msg]]
else
processAction RemoveRoom
@@ -230,7 +230,7 @@
-- when not removing room
ready <- client's isReady
- when (not master || (gameProgress && playersNum > 1)) . io $ do
+ when (not master || playersNum > 1) . io $ do
modifyRoom rnc (\r -> r{
playersIn = playersIn r - 1,
readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
--- a/hedgewars/uAIAmmoTests.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uAIAmmoTests.pas Thu Aug 09 01:01:06 2012 +0400
@@ -1096,7 +1096,8 @@
x, y, trackFall: LongInt;
cake: TGear;
begin
- Level:= Level; // avoid compiler hint
+ if (Level > 2) then
+ exit(BadTurn);
ap.ExplR:= 0;
ap.Time:= 0;
ap.Power:= BadTurn; // use it as max score value in checkCakeWalk
--- a/hedgewars/uConsts.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uConsts.pas Thu Aug 09 01:01:06 2012 +0400
@@ -166,7 +166,7 @@
cMinZoomLevel = 3.5;
cZoomDelta = 0.20;
{$ELSE}
- cMaxZoomLevel = 0.25;
+ cMaxZoomLevel = 1.0;
cMinZoomLevel = 3.0;
cZoomDelta = 0.25;
{$ENDIF}
@@ -246,6 +246,7 @@
gmRemoveFromList = $00004000;
gmAddToList = $00008000;
+ gmDelete = $00010000;
gmAllStoppable = gmLeft or gmRight or gmUp or gmDown or gmAttack or gmPrecise;
cMaxSlotIndex = 9;
--- a/hedgewars/uFloat.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uFloat.pas Thu Aug 09 01:01:06 2012 +0400
@@ -369,7 +369,7 @@
function hwPow(const t: hwFloat;p: LongWord): hwFloat;
begin
hwPow:= t;
-if p mod 2 = 0 then hwPow.isNegative:= t.isNegative;
+if p mod 2 = 0 then hwPow.isNegative:= false;
while p > 0 do
begin
--- a/hedgewars/uGears.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uGears.pas Thu Aug 09 01:01:06 2012 +0400
@@ -207,23 +207,28 @@
curHandledGear:= t;
t:= curHandledGear^.NextGear;
- if curHandledGear^.Message and gmRemoveFromList <> 0 then
- begin
- RemoveGearFromList(curHandledGear);
- // since I can't think of any good reason this would ever be separate from a remove from list, going to keep it inside this block
- if curHandledGear^.Message and gmAddToList <> 0 then InsertGearToList(curHandledGear);
- curHandledGear^.Message:= curHandledGear^.Message and (not (gmRemoveFromList or gmAddToList))
- end;
- if curHandledGear^.Active then
+ if curHandledGear^.Message and gmDelete <> 0 then
+ DeleteGear(curHandledGear)
+ else
begin
- if curHandledGear^.RenderTimer and (curHandledGear^.Timer > 500) and ((curHandledGear^.Timer mod 1000) = 0) then
+ if curHandledGear^.Message and gmRemoveFromList <> 0 then
+ begin
+ RemoveGearFromList(curHandledGear);
+ // since I can't think of any good reason this would ever be separate from a remove from list, going to keep it inside this block
+ if curHandledGear^.Message and gmAddToList <> 0 then InsertGearToList(curHandledGear);
+ curHandledGear^.Message:= curHandledGear^.Message and (not (gmRemoveFromList or gmAddToList))
+ end;
+ if curHandledGear^.Active then
begin
- FreeTexture(curHandledGear^.Tex);
- curHandledGear^.Tex:= RenderStringTex(inttostr(curHandledGear^.Timer div 1000), cWhiteColor, fntSmall);
- end;
- curHandledGear^.doStep(curHandledGear);
- // might be useful later
- //ScriptCall('onGearStep', Gear^.uid);
+ if curHandledGear^.RenderTimer and (curHandledGear^.Timer > 500) and ((curHandledGear^.Timer mod 1000) = 0) then
+ begin
+ FreeTexture(curHandledGear^.Tex);
+ curHandledGear^.Tex:= RenderStringTex(inttostr(curHandledGear^.Timer div 1000), cWhiteColor, fntSmall);
+ end;
+ curHandledGear^.doStep(curHandledGear);
+ // might be useful later
+ //ScriptCall('onGearStep', Gear^.uid);
+ end
end
end;
curHandledGear:= nil;
--- a/hedgewars/uGearsUtils.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uGearsUtils.pas Thu Aug 09 01:01:06 2012 +0400
@@ -510,7 +510,7 @@
count: LongInt = 0;
begin
if (y and LAND_HEIGHT_MASK) = 0 then
- for i:= min(x + r, LAND_WIDTH - 4) downto max(x - r, 0) do
+ for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 4) do
if Land[y, i] and mask <> 0 then
begin
inc(count);
--- a/hedgewars/uLandGraphics.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uLandGraphics.pas Thu Aug 09 01:01:06 2012 +0400
@@ -82,19 +82,19 @@
var i: LongInt;
begin
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if (Land[y + dy, i] and lfIndestructible) = 0 then
Land[y + dy, i]:= Value;
if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if (Land[y - dy, i] and lfIndestructible) = 0 then
Land[y - dy, i]:= Value;
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if (Land[y + dx, i] and lfIndestructible) = 0 then
Land[y + dx, i]:= Value;
if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if (Land[y - dx, i] and lfIndestructible) = 0 then
Land[y - dx, i]:= Value;
end;
@@ -105,25 +105,25 @@
if not doSet then
begin
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if isCurrent then
Land[y + dy, i]:= Land[y + dy, i] and $FF7F
else if Land[y + dy, i] and $007F > 0 then
Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) - 1);
if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if isCurrent then
Land[y - dy, i]:= Land[y - dy, i] and $FF7F
else if Land[y - dy, i] and $007F > 0 then
Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) - 1);
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if isCurrent then
Land[y + dx, i]:= Land[y + dx, i] and $FF7F
else if Land[y + dx, i] and $007F > 0 then
Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) - 1);
if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if isCurrent then
Land[y - dx, i]:= Land[y - dx, i] and $FF7F
else if Land[y - dx, i] and $007F > 0 then
@@ -132,25 +132,25 @@
else
begin
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if isCurrent then
Land[y + dy, i]:= Land[y + dy, i] or $80
else if Land[y + dy, i] and $007F < 127 then
Land[y + dy, i]:= (Land[y + dy, i] and $FF80) or ((Land[y + dy, i] and $7F) + 1);
if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if isCurrent then
Land[y - dy, i]:= Land[y - dy, i] or $80
else if Land[y - dy, i] and $007F < 127 then
Land[y - dy, i]:= (Land[y - dy, i] and $FF80) or ((Land[y - dy, i] and $7F) + 1);
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if isCurrent then
Land[y + dx, i]:= Land[y + dx, i] or $80
else if Land[y + dx, i] and $007F < 127 then
Land[y + dx, i]:= (Land[y + dx, i] and $FF80) or ((Land[y + dx, i] and $7F) + 1);
if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if isCurrent then
Land[y - dx, i]:= Land[y - dx, i] or $80
else if Land[y - dx, i] and $007F < 127 then
@@ -207,7 +207,7 @@
begin
t:= y + dy;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
@@ -216,7 +216,7 @@
t:= y - dy;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
@@ -225,7 +225,7 @@
t:= y + dx;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
@@ -234,7 +234,7 @@
t:= y - dx;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
@@ -250,7 +250,7 @@
cnt:= 0;
t:= y + dy;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if (Land[t, i] and lfIndestructible) = 0 then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -272,7 +272,7 @@
t:= y - dy;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if (Land[t, i] and lfIndestructible) = 0 then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -294,7 +294,7 @@
t:= y + dx;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if (Land[t, i] and lfIndestructible) = 0 then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -315,7 +315,7 @@
end;
t:= y - dx;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if (Land[t, i] and lfIndestructible) = 0 then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -342,7 +342,7 @@
begin
t:= y + dy;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -357,7 +357,7 @@
t:= y - dy;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dx, LAND_WIDTH - 1) downto Max(x - dx, 0) do
+ for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -371,7 +371,7 @@
t:= y + dx;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -386,7 +386,7 @@
t:= y - dx;
if (t and LAND_HEIGHT_MASK) = 0 then
- for i:= Min(x + dy, LAND_WIDTH - 1) downto Max(x - dy, 0) do
+ for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
if ((Land[t, i] and lfBasic) <> 0) or ((Land[t, i] and lfObject) <> 0) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
@@ -489,8 +489,8 @@
begin
for i:= 0 to Pred(Count) do
begin
- for ty:= Min(y + Radius, LAND_HEIGHT) downto Max(y - Radius, 0) do
- for tx:= Min(LAND_WIDTH, ar^[i].Right + Radius) downto Max(0, ar^[i].Left - Radius) do
+ for ty:= Max(y - Radius, 0) to Min(y + Radius, LAND_HEIGHT) do
+ for tx:= Max(0, ar^[i].Left - Radius) to Min(LAND_WIDTH, ar^[i].Right + Radius) do
begin
if (Land[ty, tx] and lfIndestructible) = 0 then
begin
@@ -516,8 +516,8 @@
for i:= 0 to Pred(Count) do
begin
- for ty:= Min(y + Radius, LAND_HEIGHT) downto Max(y - Radius, 0) do
- for tx:= Min(LAND_WIDTH, ar^[i].Right + Radius) downto Max(0, ar^[i].Left - Radius) do
+ for ty:= Max(y - Radius, 0) to Min(y + Radius, LAND_HEIGHT) do
+ for tx:= Max(0, ar^[i].Left - Radius) to Min(LAND_WIDTH, ar^[i].Right + Radius) do
if ((Land[ty, tx] and lfBasic) <> 0) or ((Land[ty, tx] and lfObject) <> 0) then
begin
if (cReducedQuality and rqBlurryLand) = 0 then
--- a/hedgewars/uScript.pas Mon Aug 06 00:44:32 2012 +0400
+++ b/hedgewars/uScript.pas Thu Aug 09 01:01:06 2012 +0400
@@ -412,7 +412,7 @@
begin
gear:= GearByUID(lua_tointeger(L, 1));
if gear <> nil then
- DeleteGear(gear);
+ gear^.Message:= gear^.Message or gmDelete;
end;
lc_deletegear:= 0
end;
--- a/tools/PascalParser.hs Mon Aug 06 00:44:32 2012 +0400
+++ b/tools/PascalParser.hs Thu Aug 09 01:01:06 2012 +0400
@@ -270,12 +270,12 @@
char ';'
comments
forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
- many functionDecorator
+ inline <- liftM (any (== "inline;")) $ many functionDecorator
b <- if isImpl && (not forward) then
liftM Just functionBody
else
return Nothing
- return $ [OperatorDeclaration i rid ret vs b]
+ return $ [OperatorDeclaration i rid inline ret vs b]
funcDecl = do
@@ -295,21 +295,24 @@
char ';'
comments
forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
- many functionDecorator
+ inline <- liftM (any (== "inline;")) $ many functionDecorator
b <- if isImpl && (not forward) then
liftM Just functionBody
else
return Nothing
- return $ [FunctionDeclaration i ret vs b]
+ return $ [FunctionDeclaration i inline ret vs b]
- functionDecorator = choice [
- try $ string "inline;"
- , try $ caseInsensitiveString "cdecl;"
- , try $ string "overload;"
- , try $ string "export;"
- , try $ string "varargs;"
- , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
- ] >> comments
+ functionDecorator = do
+ d <- choice [
+ try $ string "inline;"
+ , try $ caseInsensitiveString "cdecl;"
+ , try $ string "overload;"
+ , try $ string "export;"
+ , try $ string "varargs;"
+ , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
+ ]
+ comments
+ return d
program = do
--- a/tools/PascalUnitSyntaxTree.hs Mon Aug 06 00:44:32 2012 +0400
+++ b/tools/PascalUnitSyntaxTree.hs Thu Aug 09 01:01:06 2012 +0400
@@ -19,8 +19,8 @@
deriving Show
data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
| VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression)
- | FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
- | OperatorDeclaration String Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
+ | FunctionDeclaration Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
+ | OperatorDeclaration String Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
deriving Show
data TypeDecl = SimpleType Identifier
| RangeType Range
--- a/tools/pas2c.hs Mon Aug 06 00:44:32 2012 +0400
+++ b/tools/pas2c.hs Thu Aug 09 01:01:06 2012 +0400
@@ -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,26 @@
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"
+ ph <- phrase2C . appendPhrase (BuiltInFunctionCall [Reference $ SimpleReference i'] (SimpleReference (Identifier inc BTUnknown))) $ wrapPhrase p
+ return . braces $
+ i <+> text "=" <+> e1 <> semi
$$
- ph
+ iType <+> i <> text "__end__" <+> text "=" <+> e2 <+> text add <> semi
+ $$
+ text "do" <+> ph <+>
+ text "while" <> parens (i <+> text "!=" <+> i <> text "__end__") <> semi
+ where
+ appendPhrase p (Phrases ps) = Phrases $ ps ++ [p]
phrase2C (RepeatCycle e' p') = do
e <- expr2C e'
p <- phrase2C (Phrases p')
@@ -992,7 +1017,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 +1027,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