fcl-passrc: resolver: eval currency, binary with currency gives currency

git-svn-id: trunk@38805 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -283,6 +283,7 @@ type
   MaxPrecInt = int64;
   MaxPrecUInt = qword;
   MaxPrecFloat = extended;
+  MaxPrecCurrency = currency;
 const
   // Note: when FPC compares int64 with qword it converts the qword to an int64,
   //       possibly resulting in a range check error -> using a qword const instead
@@ -309,6 +310,7 @@ type
     revkInt,  // TResEvalInt
     revkUInt, // TResEvalUInt
     revkFloat, // TResEvalFloat
+    revkCurrency, // TResEvalCurrency
     revkString, // TResEvalString
     revkUnicodeString, // TResEvalUTF16
     revkEnum,     // TResEvalEnum
@@ -422,6 +424,19 @@ type
     function IsInt(out Int: MaxPrecInt): boolean;
   end;
 
+  { TResEvalCurrency }
+
+  TResEvalCurrency = class(TResEvalValue)
+  public
+    Value: MaxPrecCurrency;
+    constructor Create; override;
+    constructor CreateValue(const aValue: MaxPrecCurrency);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+    function IsInt(out Int: MaxPrecInt): boolean;
+    function AsInt64: int64;
+  end;
+
   { TResEvalString - Kind=revkString }
 
   TResEvalString = class(TResEvalValue)
@@ -875,6 +890,45 @@ begin
     Result:=v.AsDebugString;
 end;
 
+{ TResEvalCurrency }
+
+constructor TResEvalCurrency.Create;
+begin
+  inherited Create;
+  Kind:=revkCurrency;
+end;
+
+constructor TResEvalCurrency.CreateValue(const aValue: MaxPrecCurrency);
+begin
+  Create;
+  Value:=aValue;
+end;
+
+function TResEvalCurrency.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalCurrency(Result).Value:=Value;
+end;
+
+function TResEvalCurrency.AsString: string;
+begin
+  str(Value,Result);
+end;
+
+function TResEvalCurrency.IsInt(out Int: MaxPrecInt): boolean;
+var
+  i: Int64;
+begin
+  i:=PInt64(@Value)^;
+  Result:=(i mod 10000)=0;
+  Int:=i div 10000;
+end;
+
+function TResEvalCurrency.AsInt64: int64;
+begin
+  Result:=PInt64(@Value)^;
+end;
+
 { TResEvalBool }
 
 constructor TResEvalBool.Create;
@@ -1056,7 +1110,14 @@ begin
         if Result.Element<>nil then
           Result:=Result.Clone;
         TResEvalFloat(Result).FloatValue:=-TResEvalFloat(Result).FloatValue;
-        end
+        end;
+      revkCurrency:
+        begin
+        if TResEvalCurrency(Result).Value=0 then exit;
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalCurrency(Result).Value:=-TResEvalCurrency(Result).Value;
+        end;
       else
         begin
         if Result.Element=nil then
@@ -1347,6 +1408,7 @@ var
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   Flo: MaxPrecFloat;
+  aCurrency: MaxPrecCurrency;
   LeftCP, RightCP: TSystemCodePage;
   LeftSet, RightSet: TResEvalSet;
   i: Integer;
@@ -1375,6 +1437,8 @@ begin
         IntAddUInt(Int,TResEvalUInt(RightValue).UInt);
       revkFloat: // int + float
         Result:=TResEvalFloat.CreateValue(Int + TResEvalFloat(RightValue).FloatValue);
+      revkCurrency: // int + currency
+        Result:=TResEvalCurrency.CreateValue(Int + TResEvalCurrency(RightValue).Value);
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1395,6 +1459,8 @@ begin
         end;
       revkFloat: // uint + float
         Result:=TResEvalFloat.CreateValue(UInt + TResEvalFloat(RightValue).FloatValue);
+      revkCurrency: // uint + currency
+        Result:=TResEvalCurrency.CreateValue(UInt + TResEvalCurrency(RightValue).Value);
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1412,6 +1478,8 @@ begin
         Result:=TResEvalFloat.CreateValue(Flo + TResEvalUInt(RightValue).UInt);
       revkFloat: // float + float
         Result:=TResEvalFloat.CreateValue(Flo + TResEvalFloat(RightValue).FloatValue);
+      revkCurrency: // float + Currency
+        Result:=TResEvalCurrency.CreateValue(Flo + TResEvalCurrency(RightValue).Value);
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryAddExpr float+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1419,6 +1487,25 @@ begin
         RaiseNotYetImplemented(20170711145637,Expr);
       end;
       end;
+    revkCurrency:
+      begin
+      aCurrency:=TResEvalCurrency(LeftValue).Value;
+      case RightValue.Kind of
+      revkInt: // currency + int
+        Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalInt(RightValue).Int);
+      revkUInt: // currency + uint
+        Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalUInt(RightValue).UInt);
+      revkFloat: // currency + float
+        Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalFloat(RightValue).FloatValue);
+      revkCurrency: // currency + currency
+        Result:=TResEvalCurrency.CreateValue(aCurrency + TResEvalCurrency(RightValue).Value);
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryAddExpr currency+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20180421163819,Expr);
+      end;
+      end;
     revkString:
       case RightValue.Kind of
       revkString:
@@ -1520,6 +1607,7 @@ var
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   Flo: MaxPrecFloat;
+  aCurrency: MaxPrecCurrency;
   LeftSet, RightSet: TResEvalSet;
   i: Integer;
 begin
@@ -1568,6 +1656,17 @@ begin
         on E: EOverflow do
           RaiseOverflowArithmetic(20170711151313,Expr);
       end;
+    revkCurrency:
+      // int - currency
+      try
+        {$Q+}
+        aCurrency:=MaxPrecCurrency(Int) - TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164011,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1612,6 +1711,17 @@ begin
         on E: EOverflow do
           RaiseOverflowArithmetic(20170711151428,Expr);
       end;
+    revkCurrency:
+      // uint - currency
+      try
+        {$Q+}
+        aCurrency:=MaxPrecCurrency(UInt) - TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164005,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinarySubExpr sub uint-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1656,6 +1766,17 @@ begin
         on E: EOverflow do
           RaiseOverflowArithmetic(20170711151552,Expr);
       end;
+    revkCurrency:
+      // float - currency
+      try
+        {$Q+}
+        aCurrency:=aCurrency - TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164054,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinarySubExpr sub float-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1663,6 +1784,61 @@ begin
       RaiseNotYetImplemented(20170711151600,Expr);
     end;
     end;
+  revkCurrency:
+    begin
+    aCurrency:=TResEvalCurrency(LeftValue).Value;
+    case RightValue.Kind of
+    revkInt:
+      // currency - int
+      try
+        {$Q+}
+        aCurrency:=aCurrency - TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164200,Expr);
+      end;
+    revkUInt:
+      // currency - uint
+      try
+        {$Q+}
+        aCurrency:=aCurrency - TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164218,Expr);
+      end;
+    revkFloat:
+      // currency - float
+      try
+        {$Q+}
+        aCurrency:=aCurrency - TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164250,Expr);
+      end;
+    revkCurrency:
+      // currency - currency
+      try
+        {$Q+}
+        aCurrency:=aCurrency - TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164258,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinarySubExpr sub currency-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20180421164312,Expr);
+    end;
+    end;
   revkSetOfInt:
     case RightValue.Kind of
     revkSetOfInt:
@@ -1708,6 +1884,7 @@ var
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   Flo: MaxPrecFloat;
+  aCurrency: MaxPrecCurrency;
   LeftSet, RightSet: TResEvalSet;
   i: Integer;
 begin
@@ -1760,6 +1937,16 @@ begin
       except
         RaiseOverflowArithmetic(20170711164541,Expr);
       end;
+    revkCurrency:
+      // int * currency
+      try
+        {$Q+}
+        aCurrency:=Int * TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421164426,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1813,6 +2000,16 @@ begin
       except
         RaiseOverflowArithmetic(20170711164800,Expr);
       end;
+    revkCurrency:
+      // uint * currency
+      try
+        {$Q+}
+        aCurrency:=UInt * TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421164500,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryMulExpr mul uint*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1855,6 +2052,16 @@ begin
       except
         RaiseOverflowArithmetic(20170711164955,Expr);
       end;
+    revkCurrency:
+      // float * currency
+      try
+        {$Q+}
+        Flo:=Flo * TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20180421164542,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryMulExpr mul float*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1862,6 +2069,58 @@ begin
       RaiseNotYetImplemented(20170711165004,Expr);
     end;
     end;
+  revkCurrency:
+    begin
+    aCurrency:=TResEvalCurrency(LeftValue).Value;
+    case RightValue.Kind of
+    revkInt:
+      // currency * int
+      try
+        {$Q+}
+        aCurrency:=aCurrency * TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        on E: EOverflow do
+          RaiseOverflowArithmetic(20180421164636,Expr);
+      end;
+    revkUInt:
+      // currency * uint
+      try
+        {$Q+}
+        aCurrency:=aCurrency * TResEvalUInt(RightValue).UInt;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421164654,Expr);
+      end;
+    revkFloat:
+      // currency * float
+      try
+        {$Q+}
+        Flo:=aCurrency * TResEvalFloat(RightValue).FloatValue;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20180421164718,Expr);
+      end;
+    revkCurrency:
+      // currency * currency
+      try
+        {$Q+}
+        aCurrency:=aCurrency * TResEvalCurrency(RightValue).Value;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421164806,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryMulExpr mul currency*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20180421164817,Expr);
+    end;
+    end;
   revkSetOfInt:
     case RightValue.Kind of
     revkSetOfInt:
@@ -1907,6 +2166,7 @@ var
   Int: MaxPrecInt;
   UInt: MaxPrecUInt;
   Flo: MaxPrecFloat;
+  aCurrency: MaxPrecCurrency;
 begin
   Result:=nil;
   case LeftValue.Kind of
@@ -1935,7 +2195,17 @@ begin
         RaiseMsg(20170711144525,nDivByZero,sDivByZero,[],Expr);
       end;
       Result:=TResEvalFloat.CreateValue(Flo);
-      end
+      end;
+    revkCurrency:
+      begin
+      // int / currency
+      try
+        aCurrency:=Int / TResEvalCurrency(RightValue).Value;
+      except
+        RaiseMsg(20180421164915,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalCurrency.CreateValue(aCurrency);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryDivideExpr int / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -1968,7 +2238,17 @@ begin
         RaiseMsg(20170711144912,nDivByZero,sDivByZero,[],Expr);
       end;
       Result:=TResEvalFloat.CreateValue(Flo);
-      end
+      end;
+    revkCurrency:
+      begin
+      // uint / currency
+      try
+        aCurrency:=UInt / TResEvalCurrency(RightValue).Value;
+      except
+        RaiseMsg(20180421164959,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalCurrency.CreateValue(aCurrency);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryDivideExpr uint / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2001,7 +2281,17 @@ begin
         RaiseMsg(20170711145040,nDivByZero,sDivByZero,[],Expr);
       end;
       Result:=TResEvalFloat.CreateValue(Flo);
-      end
+      end;
+    revkCurrency:
+      begin
+      // float / currency
+      try
+        aCurrency:=Flo / TResEvalCurrency(RightValue).Value;
+      except
+        RaiseMsg(20180421165058,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalCurrency.CreateValue(aCurrency);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryDivideExpr float / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2009,6 +2299,49 @@ begin
       RaiseNotYetImplemented(20170711145050,Expr);
     end;
     end;
+  revkCurrency:
+    begin
+    aCurrency:=TResEvalCurrency(LeftValue).Value;
+    case RightValue.Kind of
+    revkInt:
+      // currency / int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20180421165154,Expr)
+      else
+        Result:=TResEvalCurrency.CreateValue(aCurrency / TResEvalInt(RightValue).Int);
+    revkUInt:
+      // currency / uint
+      if TResEvalUInt(RightValue).UInt=0 then
+        RaiseDivByZero(20180421165205,Expr)
+      else
+        Result:=TResEvalCurrency.CreateValue(aCurrency / TResEvalUInt(RightValue).UInt);
+    revkFloat:
+      begin
+      // currency / float
+      try
+        aCurrency:=aCurrency / TResEvalFloat(RightValue).FloatValue;
+      except
+        RaiseMsg(20180421165237,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalCurrency.CreateValue(aCurrency);
+      end;
+    revkCurrency:
+      begin
+      // currency / currency
+      try
+        aCurrency:=aCurrency / TResEvalCurrency(RightValue).Value;
+      except
+        RaiseMsg(20180421165252,nDivByZero,sDivByZero,[],Expr);
+      end;
+      Result:=TResEvalCurrency.CreateValue(aCurrency);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryDivideExpr currency / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20180421165301,Expr);
+    end;
+    end;
   else
     {$IFDEF VerbosePasResolver}
     writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2350,6 +2683,8 @@ begin
         TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalUInt(RightValue).UInt;
       revkFloat:
         TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalFloat(RightValue).FloatValue;
+      revkCurrency:
+        TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalCurrency(RightValue).Value;
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryNEqualExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2368,6 +2703,8 @@ begin
         TResEvalBool(Result).B:=UInt=TResEvalUInt(RightValue).UInt;
       revkFloat:
         TResEvalBool(Result).B:=UInt=TResEvalFloat(RightValue).FloatValue;
+      revkCurrency:
+        TResEvalBool(Result).B:=UInt=TResEvalCurrency(RightValue).Value;
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryNEqualExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2384,6 +2721,8 @@ begin
         TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalUInt(RightValue).UInt;
       revkFloat:
         TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalFloat(RightValue).FloatValue;
+      revkCurrency:
+        TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalCurrency(RightValue).Value;
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryNEqualExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2391,6 +2730,23 @@ begin
         Result.Free;
         RaiseNotYetImplemented(20170601122806,Expr);
       end;
+    revkCurrency:
+      case RightValue.Kind of
+      revkInt:
+        TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalInt(RightValue).Int;
+      revkUInt:
+        TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalUInt(RightValue).UInt;
+      revkFloat:
+        TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalFloat(RightValue).FloatValue;
+      revkCurrency:
+        TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalCurrency(RightValue).Value;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryNEqualExpr currency ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20180421165438,Expr);
+      end;
     revkString:
       case RightValue.Kind of
       revkString:
@@ -2535,6 +2891,17 @@ begin
         eopGreaterThanEqual:
           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalFloat(RightValue).FloatValue;
         end;
+      revkCurrency:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalCurrency(RightValue).Value;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalCurrency(RightValue).Value;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalCurrency(RightValue).Value;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalCurrency(RightValue).Value;
+        end;
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2577,6 +2944,17 @@ begin
         eopGreaterThanEqual:
           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalFloat(RightValue).FloatValue;
         end;
+      revkCurrency:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalCurrency(RightValue).Value;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalCurrency(RightValue).Value;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalCurrency(RightValue).Value;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalCurrency(RightValue).Value;
+        end;
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2619,6 +2997,17 @@ begin
         eopGreaterThanEqual:
           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalFloat(RightValue).FloatValue;
         end;
+      revkCurrency:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalCurrency(RightValue).Value;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalCurrency(RightValue).Value;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalCurrency(RightValue).Value;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalCurrency(RightValue).Value;
+        end;
       else
         {$IFDEF VerbosePasResolver}
         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -2626,6 +3015,59 @@ begin
         Result.Free;
         RaiseNotYetImplemented(20170601133421,Expr);
       end;
+    revkCurrency:
+      case RightValue.Kind of
+      revkInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalInt(RightValue).Int;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalInt(RightValue).Int;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalInt(RightValue).Int;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalInt(RightValue).Int;
+        end;
+      revkUInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalUInt(RightValue).UInt;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalUInt(RightValue).UInt;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalUInt(RightValue).UInt;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalUInt(RightValue).UInt;
+        end;
+      revkFloat:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalFloat(RightValue).FloatValue;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalFloat(RightValue).FloatValue;
+        end;
+      revkCurrency:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalCurrency(RightValue).Value;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalCurrency(RightValue).Value;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalCurrency(RightValue).Value;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalCurrency(RightValue).Value;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr currency ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20180421165752,Expr);
+      end;
     revkString:
       case RightValue.Kind of
       revkString:
@@ -3121,6 +3563,7 @@ function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
 var
   Int: MaxPrecInt;
   Flo: MaxPrecFloat;
+  aCurrency: MaxPrecCurrency;
 begin
   Result:=nil;
   case LeftValue.Kind of
@@ -3159,6 +3602,17 @@ begin
       except
         RaiseOverflowArithmetic(20170816154223,Expr);
       end;
+    revkCurrency:
+      // int^^currency
+      try
+        {$Q+}{$R+}
+        Flo:=Math.power(TResEvalInt(LeftValue).Int,TResEvalCurrency(RightValue).Value);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20180421165906,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryPowerExpr int ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -3200,6 +3654,17 @@ begin
       except
         RaiseOverflowArithmetic(20170816154241,Expr);
       end;
+    revkCurrency:
+      // uint^^currency
+      try
+        {$Q+}{$R+}
+        Flo:=Math.power(TResEvalUInt(LeftValue).UInt,TResEvalCurrency(RightValue).Value);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20180421165948,Expr);
+      end;
     else
       {$IFDEF VerbosePasResolver}
       writeln('TResExprEvaluator.EvalBinaryPowerExpr uint ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -3241,7 +3706,65 @@ begin
       except
         RaiseOverflowArithmetic(20170816154012,Expr);
       end;
-    end
+    revkCurrency:
+      // float ^^ currency
+      try
+        {$Q+}{$R+}
+        Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalCurrency(RightValue).Value);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalFloat.CreateValue(Flo);
+      except
+        RaiseOverflowArithmetic(20180421170016,Expr);
+      end;
+    end;
+  revkCurrency:
+    case RightValue.Kind of
+    revkInt:
+      // currency ^^ int
+      try
+        {$Q+}{$R+}
+        aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalInt(RightValue).Int);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421170235,Expr);
+      end;
+    revkUInt:
+      // currency ^^ uint
+      try
+        {$Q+}{$R+}
+        aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalUInt(RightValue).UInt);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421170240,Expr);
+      end;
+    revkFloat:
+      // currency ^^ float
+      try
+        {$Q+}{$R+}
+        aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalFloat(RightValue).FloatValue);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421170254,Expr);
+      end;
+    revkCurrency:
+      // currency ^^ currency
+      try
+        {$Q+}{$R+}
+        aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalCurrency(RightValue).Value);
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalCurrency.CreateValue(aCurrency);
+      except
+        RaiseOverflowArithmetic(20180421170311,Expr);
+      end;
+    end;
   else
     {$IFDEF VerbosePasResolver}
     writeln('TResExprEvaluator.EvalBinaryPowerExpr ^^ ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
@@ -4034,6 +4557,13 @@ begin
           str(TResEvalFloat(Value).FloatValue:Format1,ValStr)
         else
           str(TResEvalFloat(Value).FloatValue:Format1:Format2,ValStr);
+      revkCurrency:
+        if Format1<0 then
+          str(TResEvalCurrency(Value).Value,ValStr)
+        else if Format2<0 then
+          str(TResEvalCurrency(Value).Value:Format1,ValStr)
+        else
+          str(TResEvalCurrency(Value).Value:Format1:Format2,ValStr);
       revkEnum:
         begin
         ValStr:=TResEvalEnum(Value).AsString;

packages/fcl-passrc/src/pasresolver.pp

@@ -186,6 +186,10 @@ Works:
   - assigned()
   - IntfVar:=nil, IntfVar:=IntfVar, IntfVar:=ObjVar, ObjVar:=IntfVar
   - IntfVar=IntfVar2
+- currency
+  - eval type TResEvalCurrency
+  - eval +, -, *, /, ^^
+  - float*currency and currency*float computes to currency
 
 ToDo:
 - $pop, $push
@@ -5681,6 +5685,7 @@ begin
       revkBool,
       revkInt, revkUInt,
       revkFloat,
+      revkCurrency,
       revkString, revkUnicodeString,
       revkEnum: ; // ok
       else
@@ -8489,8 +8494,12 @@ begin
           eopShl, eopShr,
           eopAnd, eopOr, eopXor:
             begin
-            // use left type for result
-            SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+            if RightResolved.BaseType in btAllFloats then
+              // use right type for result
+              SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable])
+            else
+              // use left type for result
+              SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
             exit;
             end;
           eopLessThan,
@@ -8664,7 +8673,14 @@ begin
       eopMultiply, eopDivide, eopMod,
       eopPower:
         begin
-        SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+        if (RightResolved.BaseType=btCurrency)
+            or ((RightResolved.BaseType in btAllFloats)
+                and (RightResolved.BaseType>LeftResolved.BaseType)) then
+          // use right side as result
+          SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable])
+        else
+          // use left side as result
+          SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
         exit;
         end;
       eopLessThan,
@@ -10250,6 +10266,78 @@ end;
 
 function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
   bt: TResolverBaseType): TResEvalvalue;
+
+  procedure TCFloatToInt(Value: TResEvalValue; Flo: MaxPrecFloat);
+  var
+    Int, MinIntVal, MaxIntVal: MaxPrecInt;
+  begin
+    if bt in (btAllInteger-[btQWord]) then
+      begin
+      // float to int
+      GetIntegerRange(bt,MinIntVal,MaxIntVal);
+      if (Flo<MinIntVal) or (Flo>MaxIntVal) then
+        fExprEvaluator.EmitRangeCheckConst(20170711001228,
+          Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
+      {$R-}
+      try
+        Int:=Round(Flo);
+      except
+        RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
+      end;
+      case bt of
+        btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
+        btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
+        btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
+        btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
+        btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
+        btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
+        btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
+        btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
+        btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
+        btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
+        btInt64: Result:=TResEvalInt.CreateValue(Int);
+      else
+        RaiseNotYetImplemented(20170711001513,Params);
+      end;
+      {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
+      exit;
+      end
+    else if bt=btSingle then
+      begin
+      // float to single
+      try
+        Result:=TResEvalFloat.CreateValue(single(Flo));
+      except
+        RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
+      end;
+      end
+    else if bt=btDouble then
+      begin
+      // float to double
+      try
+        Result:=TResEvalFloat.CreateValue(double(Flo));
+      except
+        RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
+      end;
+      end
+    else if bt=btCurrency then
+      begin
+      // float to currency
+      try
+        Result:=TResEvalCurrency.CreateValue(Currency(Flo));
+      except
+        RaiseMsg(20180421171840,nRangeCheckError,sRangeCheckError,[],Params);
+      end;
+      end
+    else
+      begin
+      {$IFDEF VerbosePasResEval}
+      writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170711002542,Params);
+      end;
+  end;
+
 var
   Value: TResEvalValue;
   Int: MaxPrecInt;
@@ -10358,6 +10446,12 @@ begin
         except
           RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
         end
+      else if bt=btCurrency then
+        try
+          Result:=TResEvalCurrency.CreateValue(Currency(Int));
+        except
+          RaiseMsg(20180422093631,nRangeCheckError,sRangeCheckError,[],Params);
+        end
       else
         begin
         {$IFDEF VerbosePasResEval}
@@ -10369,63 +10463,21 @@ begin
     revkFloat:
       begin
       Flo:=TResEvalFloat(Value).FloatValue;
-      if bt in (btAllInteger-[btQWord]) then
-        begin
-        // float to int
-        GetIntegerRange(bt,MinIntVal,MaxIntVal);
-        if (Flo<MinIntVal) or (Flo>MaxIntVal) then
-          fExprEvaluator.EmitRangeCheckConst(20170711001228,
-            Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
-        {$R-}
-        try
-          Int:=Round(Flo);
-        except
-          RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
-        end;
-        case bt of
-          btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
-          btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
-          btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
-          btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
-          btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
-          btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
-          btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
-          btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
-          btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
-          btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
-          btInt64: Result:=TResEvalInt.CreateValue(Int);
-        else
-          RaiseNotYetImplemented(20170711001513,Params);
-        end;
-        {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
-        exit;
-        end
-      else if bt=btSingle then
-        begin
-        // float to single
-        try
-          Result:=TResEvalFloat.CreateValue(single(Flo));
-        except
-          RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
-        end;
-        end
-      else if bt=btDouble then
+      TCFloatToInt(Value,Flo);
+      end;
+    revkCurrency:
+      begin
+      if bt=btCurrency then
         begin
-        // float to double
-        try
-          Result:=TResEvalFloat.CreateValue(double(Flo));
-        except
-          RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
-        end;
+        Result:=Value;
+        Value:=nil;
         end
       else
         begin
-        {$IFDEF VerbosePasResEval}
-        writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170711002542,Params);
+        Flo:=TResEvalCurrency(Value).Value;
+        TCFloatToInt(Value,Flo);
         end;
-      end
+      end;
     else
       {$IFDEF VerbosePasResEval}
       writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
@@ -14070,6 +14122,20 @@ begin
           {$ENDIF}
           RaiseRangeCheck(20170802133750,RHS);
           end;
+      revkCurrency:
+        if TResEvalCurrency(RValue).IsInt(Int) then
+          begin
+          if (MinVal>Int) or (MaxVal<Int) then
+            fExprEvaluator.EmitRangeCheckConst(20180421171325,
+              IntToStr(Int),MinVal,MaxVal,RHS,mtError);
+          end
+        else
+          begin
+          {$IFDEF VerbosePasResEval}
+          writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalCurrency(RValue).Value),' ',TResEvalCurrency(RValue).Value,' ',high(MaxPrecInt));
+          {$ENDIF}
+          RaiseRangeCheck(20180421171438,RHS);
+          end;
       else
         {$IFDEF VerbosePasResEval}
         writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
@@ -14088,7 +14154,7 @@ begin
       end
     else if RValue.Kind in [revkNil,revkBool] then
       // simple type check is enough
-    else if LeftResolved.BaseType in [btSingle,btDouble] then
+    else if LeftResolved.BaseType in [btSingle,btDouble,btCurrency] then
       // simple type check is enough
       // ToDo: warn if precision loss
     else if LeftResolved.BaseType in btAllChars then

packages/fcl-passrc/tests/tcresolver.pas

@@ -206,6 +206,7 @@ type
     Procedure TestIntegerTypeCast;
     Procedure TestConstFloatOperators;
     Procedure TestFloatTypeCast;
+    Procedure TestCurrency;
 
     // boolean
     Procedure TestBoolTypeCast;
@@ -2588,6 +2589,37 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
+procedure TTestResolver.TestCurrency;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a: currency = -922337203685477.5808;',
+  '  b: currency = 922337203685477.5807;',
+  '  c=double(currency(-123456890123456));',
+  '  d=currency(-1);',
+  '  e=currency(word(-1));',
+  '  i: longint = 1;',
+  'begin',
+  '  a:=i;',
+  '  a:=i+a;',
+  '  a:=a+i;',
+  '  a:=-a+b;',
+  '  a:=a*b;',
+  '  a:=a/b;',
+  '  a:=a/1.23;',
+  '  a:=1.2345;',
+  '  a:=a-i;',
+  '  a:=i-a;',
+  '  a:=a*i;',
+  '  a:=i*a;',
+  '  a:=a/i;',
+  '  a:=i/a;',
+  '']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestBoolTypeCast;
 begin
   StartProgram(false);