fcl-passrc: const eval: pred(), succ(), ord()

git-svn-id: trunk@36601 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -17,42 +17,45 @@ Abstract:
   Evaluation of Pascal constants.
 
 Works:
-  - Emitting range check warnings
-  - Error on overflow
-  - bool: not, =, <>, and, or, xor, low(), high()
-  - int/uint
-    - unary +, -
-    - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
-  - string: +
-  - float:
-  - enum/set
+- Emitting range check warnings
+- Error on overflow
+- bool: not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
+- int/uint
+  - unary +, -
+  - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
+  - low(), high(), pred(), succ(), ord()
+  - typecast int
+- string:
+  - +
+  - pred(), succ()
+- float:
+- enum/set
 
 ToDo:
-  - enable eval via option, default off
-  - bool:
-    - low(), high(), pred(), succ(), ord()
-  - int
-    - typecast
-    - low(), high(), pred(), succ()
-  - string:
-    - =, <>, <, >, <=, >=
-    - string encoding
-    - s[]
-    - length(string)
-    - chr(), ord(), low(), high(), pred(), succ()
-    - #65
-    - #$DC00
-  - float
-    - typecast float
-    - /
-    - +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
-  - enum
-    - low(), high(), pred(), succ(), ord(), typecast
-  - sets
-    - [a,b,c..d]
-    - +, -, *, =, <>, <=, >=, in, ><
-  - arrays
-    - length(), low(), high()
+- enable eval via option, default off
+- bool:
+   - boolean(1)
+- int
+  - typecast intsingle(-1), uintsingle(-1), longint(-1)
+- string:
+  - =, <>, <, >, <=, >=
+  - string encoding
+  - s[]
+  - length(string)
+  - chr(), ord(), low(), high()
+  - #65
+  - #$DC00
+- float
+  - typecast float
+  - /
+  - +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
+- enum
+  - low(), high(), pred(), succ(), ord(), typecast
+- sets
+  - [a,b,c..d]
+  - +, -, *, =, <>, <=, >=, in, ><
+- arrays
+  - length(), low(), high()
 }
 unit PasResolveEval;
 
@@ -235,6 +238,16 @@ const
   //       possibly resulting in a range check error -> using a qword const instead
   HighIntAsUInt = MaxPrecUInt(High(MaxPrecInt));
 
+const
+  MinSafeIntCurrency = -922337203685477;
+  MaxSafeIntCurrency =  922337203685477;
+  MinSafeIntSingle = -16777216;
+  MaxSafeIntSingle =  16777216;
+  MaskUIntSingle = $3fffff;
+  MinSafeIntDouble = -$10000000000000;
+  MaxSafeIntDouble =   $fffffffffffff;
+  MaskUIntDouble = $fffffffffffff;
+
 type
   { TResEvalValue }
 
@@ -276,15 +289,38 @@ type
     function AsString: string; override;
   end;
 
+  TResEvalTypedInt = (
+    reitNone,
+    reitByte,
+    reitShortInt,
+    reitWord,
+    reitSmallInt,
+    reitUIntSingle,
+    reitIntSingle,
+    reitLongWord,
+    reitLongInt,
+    reitUIntDouble,
+    reitIntDouble);
+  TResEvalTypedInts = set of TResEvalTypedInt;
+
+const
+  reitDefaults = [reitNone,reitByte,reitShortInt,reitWord,reitSmallInt,reitLongWord,reitLongInt];
+  reitAllSigned = [reitNone,reitShortInt,reitSmallInt,reitIntSingle,reitLongInt,reitIntDouble];
+  reitAllUnsigned = [reitByte,reitWord,reitUIntSingle,reitLongWord,reitUIntDouble];
+
+type
   { TResEvalInt }
 
   TResEvalInt = class(TResEvalValue)
   public
     Int: MaxPrecInt;
+    Typed: TResEvalTypedInt;
     constructor Create; override;
     constructor CreateValue(const aValue: MaxPrecInt);
+    constructor CreateValue(const aValue: MaxPrecInt; aTyped: TResEvalTypedInt);
     function Clone: TResEvalValue; override;
     function AsString: string; override;
+    function AsDebugString: string; override;
   end;
 
   { TResEvalUInt }
@@ -421,6 +457,7 @@ type
 
   TResExprEvaluator = class
   private
+    FAllowedInts: TResEvalTypedInts;
     FOnEvalIdentifier: TPasResEvalIdentHandler;
     FOnEvalParams: TPasResEvalParamsHandler;
     FOnLog: TPasResEvalLogHandler;
@@ -453,8 +490,21 @@ type
     function EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
     function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
+    procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
+    procedure SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
+    procedure PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
+    procedure SuccInt(Value: TResEvalInt; ErrorEl: TPasElement);
+    procedure PredUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
+    procedure SuccUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
+    procedure PredString(Value: TResEvalString; ErrorEl: TPasElement);
+    procedure SuccString(Value: TResEvalString; ErrorEl: TPasElement);
+    procedure PredUnicodeString(Value: TResEvalUTF16; ErrorEl: TPasElement);
+    procedure SuccUnicodeString(Value: TResEvalUTF16; ErrorEl: TPasElement);
+    procedure PredEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
+    procedure SuccEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
     function CreateResEvalInt(UInt: MaxPrecUInt): TResEvalValue; virtual;
   public
+    constructor Create;
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
     function IsInRange(Expr, RangeExpr: TPasExpr; EmitHints: boolean): boolean;
     function IsConst(Expr: TPasExpr): boolean;
@@ -463,9 +513,13 @@ type
       PosEl: TPasElement); virtual;
     procedure EmitRangeCheckConst(id: int64; const aValue: String;
       MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
+    function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalInt; virtual;
+    procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
+    procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     property OnLog: TPasResEvalLogHandler read FOnLog write FOnLog;
     property OnEvalIdentifier: TPasResEvalIdentHandler read FOnEvalIdentifier write FOnEvalIdentifier;
     property OnEvalParams: TPasResEvalParamsHandler read FOnEvalParams write FOnEvalParams;
+    property AllowedInts: TResEvalTypedInts read FAllowedInts write FAllowedInts;
   end;
   TResExprEvaluatorClass = class of TResExprEvaluator;
 
@@ -869,7 +923,13 @@ begin
         if TResEvalInt(Result).Int=0 then exit;
         if Result.Element<>nil then
           Result:=Result.Clone;
-        TResEvalInt(Result).Int:=-TResEvalInt(Result).Int;
+        if TResEvalInt(Result).Int=0 then exit;
+        if not (TResEvalInt(Result).Typed in reitAllSigned) then
+          begin
+          // switch to untyped
+          TResEvalInt(Result).Typed:=reitNone;
+          end;
+        TResEvalInt(Result).Int:=-TResEvalInt(Result).Int
         end;
       revkUInt:
         begin
@@ -897,7 +957,19 @@ begin
         begin
         if Result.Element<>nil then
           Result:=Result.Clone;
-        TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
+        case TResEvalInt(Result).Typed of
+          reitByte: TResEvalInt(Result).Int:=not byte(TResEvalInt(Result).Int);
+          reitShortInt: TResEvalInt(Result).Int:=not shortint(TResEvalInt(Result).Int);
+          reitWord: TResEvalInt(Result).Int:=not word(TResEvalInt(Result).Int);
+          reitSmallInt: TResEvalInt(Result).Int:=not smallint(TResEvalInt(Result).Int);
+          reitUIntSingle: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $3fffff;
+          reitIntSingle: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $7fffff;
+          reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
+          reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
+          reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
+          reitIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff;
+          else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
+        end;
         end;
       revkUInt:
         begin
@@ -1945,7 +2017,7 @@ begin
   writeln('TResExprEvaluator.EvalArrayParams ');
   {$ENDIF}
   if refConst in Flags then
-    RaiseConstantExprExp(20170522173150,Expr);
+    RaiseConstantExprExp(20170522173151,Expr);
 end;
 
 function TResExprEvaluator.EvalFuncParams(Expr: TParamsExpr;
@@ -1973,7 +2045,7 @@ begin
     exit;
     end;
   if refConst in Flags then
-    RaiseConstantExprExp(20170522173150,Expr);
+    RaiseConstantExprExp(20170522173152,Expr);
 end;
 
 function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
@@ -2187,6 +2259,12 @@ begin
     Result:=TResEvalUInt.CreateValue(UInt);
 end;
 
+constructor TResExprEvaluator.Create;
+begin
+  inherited Create;
+  FAllowedInts:=ReitDefaults;
+end;
+
 function TResExprEvaluator.Eval(Expr: TPasExpr; Flags: TResEvalFlags
   ): TResEvalValue;
 var
@@ -2203,7 +2281,7 @@ begin
     exit;
     end;
   {$IFDEF VerbosePasResEval}
-  writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
+  writeln('TResExprEvaluator.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
   {$ENDIF}
   if refAutoConst in Flags then
     begin
@@ -2469,6 +2547,243 @@ begin
   EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl);
 end;
 
+function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
+  ): TResEvalInt;
+begin
+  case Value.Kind of
+    revkBool:
+      if TResEvalBool(Value).B then
+        Result:=TResEvalInt.CreateValue(1)
+      else
+        Result:=TResEvalInt.CreateValue(0);
+    revkString:
+      if length(TResEvalString(Value).S)<>1 then
+        RaiseRangeCheck(20170624160128,ErrorEl)
+      else
+        Result:=TResEvalInt.CreateValue(ord(TResEvalString(Value).S[1]));
+    revkUnicodeString:
+      if length(TResEvalUTF16(Value).S)<>1 then
+        RaiseRangeCheck(20170624160129,ErrorEl)
+      else
+        Result:=TResEvalInt.CreateValue(ord(TResEvalUTF16(Value).S[1]));
+    revkEnum:
+      Result:=TResEvalInt.CreateValue(TResEvalEnum(Value).Index);
+  else
+    {$IFDEF VerbosePasResEval}
+    writeln('TResExprEvaluator.OrdValue ',Value.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170624155932,ErrorEl);
+  end;
+end;
+
+procedure TResExprEvaluator.PredValue(Value: TResEvalValue; ErrorEl: TPasElement
+  );
+begin
+  case Value.Kind of
+    revkBool:
+      PredBool(TResEvalBool(Value),ErrorEl);
+    revkInt:
+      PredInt(TResEvalInt(Value),ErrorEl);
+    revkUInt:
+      PredUInt(TResEvalUInt(Value),ErrorEl);
+    revkString:
+      PredString(TResEvalString(Value),ErrorEl);
+    revkUnicodeString:
+      PredUnicodeString(TResEvalUTF16(Value),ErrorEl);
+    revkEnum:
+      PredEnum(TResEvalEnum(Value),ErrorEl);
+  else
+    {$IFDEF VerbosePasResEval}
+    writeln('TResExprEvaluator.PredValue ',Value.AsDebugString);
+    {$ENDIF}
+    ReleaseEvalValue(Value);
+    RaiseNotYetImplemented(20170624135738,ErrorEl);
+  end;
+end;
+
+procedure TResExprEvaluator.SuccValue(Value: TResEvalValue; ErrorEl: TPasElement
+  );
+begin
+  case Value.Kind of
+    revkBool:
+      SuccBool(TResEvalBool(Value),ErrorEl);
+    revkInt:
+      SuccInt(TResEvalInt(Value),ErrorEl);
+    revkUInt:
+      SuccUInt(TResEvalUInt(Value),ErrorEl);
+    revkString:
+      SuccString(TResEvalString(Value),ErrorEl);
+    revkUnicodeString:
+      SuccUnicodeString(TResEvalUTF16(Value),ErrorEl);
+    revkEnum:
+      SuccEnum(TResEvalEnum(Value),ErrorEl);
+  else
+    {$IFDEF VerbosePasResEval}
+    writeln('TResExprEvaluator.SuccValue ',Value.AsDebugString);
+    {$ENDIF}
+    ReleaseEvalValue(Value);
+    RaiseNotYetImplemented(20170624151252,ErrorEl);
+  end;
+end;
+
+procedure TResExprEvaluator.PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
+begin
+  if Value.B=false then
+    EmitRangeCheckConst(20170624140251,Value.AsString,
+      'true','true',ErrorEl);
+  Value.B:=not Value.B;
+end;
+
+procedure TResExprEvaluator.SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
+begin
+  if Value.B=true then
+    EmitRangeCheckConst(20170624142316,Value.AsString,
+      'false','false',ErrorEl);
+  Value.B:=not Value.B;
+end;
+
+procedure TResExprEvaluator.PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
+begin
+  if Value.Int=low(MaxPrecInt) then
+    begin
+    EmitRangeCheckConst(20170624142511,IntToStr(Value.Int),
+      IntToStr(succ(low(MaxPrecInt))),IntToStr(high(MaxPrecInt)),ErrorEl);
+    Value.Int:=high(Value.Int);
+    end
+  else
+    dec(Value.Int);
+end;
+
+procedure TResExprEvaluator.SuccInt(Value: TResEvalInt; ErrorEl: TPasElement);
+begin
+  if Value.Int=high(MaxPrecInt) then
+    begin
+    EmitRangeCheckConst(20170624142920,IntToStr(Value.Int),
+      IntToStr(low(MaxPrecInt)),IntToStr(pred(high(MaxPrecInt))),ErrorEl);
+    Value.Int:=low(Value.Int);
+    end
+  else
+    inc(Value.Int);
+end;
+
+procedure TResExprEvaluator.PredUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
+begin
+  if Value.UInt=low(MaxPrecUInt) then
+    begin
+    EmitRangeCheckConst(20170624143122,IntToStr(Value.UInt),
+      IntToStr(succ(low(MaxPrecUInt))),IntToStr(high(MaxPrecUInt)),ErrorEl);
+    Value.UInt:=high(Value.UInt);
+    end
+  else
+    dec(Value.UInt);
+end;
+
+procedure TResExprEvaluator.SuccUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
+begin
+  if Value.UInt=high(MaxPrecUInt) then
+    begin
+    EmitRangeCheckConst(20170624142921,IntToStr(Value.UInt),
+      IntToStr(low(MaxPrecUInt)),IntToStr(pred(high(MaxPrecUInt))),ErrorEl);
+    Value.UInt:=low(Value.UInt);
+    end
+  else
+    inc(Value.UInt);
+end;
+
+procedure TResExprEvaluator.PredString(Value: TResEvalString;
+  ErrorEl: TPasElement);
+begin
+  if length(Value.S)<>1 then
+    RaiseRangeCheck(20170624150138,ErrorEl);
+  if Value.S[1]=#0 then
+    begin
+    EmitRangeCheckConst(20170624150220,Value.AsString,'#1','#255',ErrorEl);
+    Value.S:=#255;
+    end
+  else
+    Value.S:=pred(Value.S[1]);
+end;
+
+procedure TResExprEvaluator.SuccString(Value: TResEvalString;
+  ErrorEl: TPasElement);
+begin
+  if length(Value.S)<>1 then
+    RaiseRangeCheck(20170624150432,ErrorEl);
+  if Value.S[1]=#255 then
+    begin
+    EmitRangeCheckConst(20170624150441,Value.AsString,'#0','#254',ErrorEl);
+    Value.S:=#0;
+    end
+  else
+    Value.S:=succ(Value.S[1]);
+end;
+
+procedure TResExprEvaluator.PredUnicodeString(Value: TResEvalUTF16;
+  ErrorEl: TPasElement);
+begin
+  if length(Value.S)<>1 then
+    RaiseRangeCheck(20170624150703,ErrorEl);
+  if Value.S[1]=#0 then
+    begin
+    EmitRangeCheckConst(20170624150710,Value.AsString,'#1','#65535',ErrorEl);
+    Value.S:=WideChar(#65535);
+    end
+  else
+    Value.S:=pred(Value.S[1]);
+end;
+
+procedure TResExprEvaluator.SuccUnicodeString(Value: TResEvalUTF16;
+  ErrorEl: TPasElement);
+begin
+  if length(Value.S)<>1 then
+    RaiseRangeCheck(20170624150849,ErrorEl);
+  if Value.S[1]=#65535 then
+    begin
+    EmitRangeCheckConst(20170624150910,Value.AsString,'#0','#65534',ErrorEl);
+    Value.S:=#0;
+    end
+  else
+    Value.S:=succ(Value.S[1]);
+end;
+
+procedure TResExprEvaluator.PredEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
+var
+  EnumValue: TPasEnumValue;
+  EnumType: TPasEnumType;
+begin
+  EnumValue:=Value.IdentEl as TPasEnumValue;
+  EnumType:=EnumValue.Parent as TPasEnumType;
+  if Value.Index<=0 then
+    begin
+    EmitRangeCheckConst(20170624144332,Value.AsString,
+      TPasEnumValue(EnumType.Values[Min(1,EnumType.Values.Count-1)]).Name,
+      TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]).Name,ErrorEl);
+    Value.Index:=EnumType.Values.Count-1;
+    end
+  else
+    dec(Value.Index);
+  Value.IdentEl:=TPasEnumValue(EnumType.Values[Value.Index]);
+end;
+
+procedure TResExprEvaluator.SuccEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
+var
+  EnumValue: TPasEnumValue;
+  EnumType: TPasEnumType;
+begin
+  EnumValue:=Value.IdentEl as TPasEnumValue;
+  EnumType:=EnumValue.Parent as TPasEnumType;
+  if Value.Index>=EnumType.Values.Count-1 then
+    begin
+    EmitRangeCheckConst(20170624145013,Value.AsString,
+      TPasEnumValue(EnumType.Values[0]).Name,
+      TPasEnumValue(EnumType.Values[Max(0,EnumType.Values.Count-2)]).Name,ErrorEl);
+    Value.Index:=0;
+    end
+  else
+    inc(Value.Index);
+  Value.IdentEl:=TPasEnumValue(EnumType.Values[Value.Index]);
+end;
+
 { TResolveData }
 
 procedure TResolveData.SetElement(AValue: TPasElement);
@@ -2571,10 +2886,19 @@ begin
   Int:=aValue;
 end;
 
+constructor TResEvalInt.CreateValue(const aValue: MaxPrecInt; aTyped: TResEvalTypedInt
+  );
+begin
+  Create;
+  Int:=aValue;
+  Typed:=aTyped;
+end;
+
 function TResEvalInt.Clone: TResEvalValue;
 begin
   Result:=inherited Clone;
   TResEvalInt(Result).Int:=Int;
+  TResEvalInt(Result).Typed:=Typed;
 end;
 
 function TResEvalInt.AsString: string;
@@ -2582,6 +2906,29 @@ begin
   Result:=IntToStr(Int);
 end;
 
+function TResEvalInt.AsDebugString: string;
+begin
+  if Typed=reitNone then
+    Result:=inherited AsDebugString
+  else
+    begin
+    str(Kind,Result);
+    case Typed of
+      reitByte: Result:=Result+':byte';
+      reitShortInt: Result:=Result+':shortint';
+      reitWord: Result:=Result+':word';
+      reitSmallInt: Result:=Result+':smallint';
+      reitUIntSingle: Result:=Result+':uintsingle';
+      reitIntSingle: Result:=Result+':intsingle';
+      reitLongWord: Result:=Result+':longword';
+      reitLongInt: Result:=Result+':longint';
+      reitUIntDouble: Result:=Result+':uintdouble';
+      reitIntDouble: Result:=Result+':intdouble';
+    end;
+    Result:=Result+'='+AsString;
+    end;
+end;
+
 { TResEvalFloat }
 
 constructor TResEvalFloat.Create;

packages/fcl-passrc/src/pasresolver.pp

@@ -207,6 +207,9 @@ unit PasResolver;
 {$mode objfpc}{$H+}
 {$inline on}
 
+{$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
+{$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
+
 interface
 
 uses
@@ -361,14 +364,6 @@ const
     'range..'
     );
 
-const
-  MinSafeIntCurrency = -922337203685477;
-  MaxSafeIntCurrency =  922337203685477;
-  MinSafeIntSingle = -16777216;
-  MaxSafeIntSingle =  16777216;
-  MinSafeIntDouble = -$10000000000000;
-  MaxSafeIntDouble =   $fffffffffffff;
-
 type
   TResolverBuiltInProc = (
     bfCustom,
@@ -1093,6 +1088,7 @@ type
       Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
     function OnExprEvalParams(Sender: TResExprEvaluator;
       Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
+    function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue;
   protected
     // custom types (added by descendant resolvers)
@@ -1140,6 +1136,8 @@ type
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
       {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; out Evaluated: TResEvalValue); virtual;
     function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
@@ -7333,22 +7331,56 @@ var
   Decl: TPasElement;
   C: TClass;
   BaseTypeData: TResElDataBaseType;
+  ResolvedType: TPasResolverResult;
 begin
   Result:=nil;
   if not (Expr.CustomData is TResolvedReference) then
     RaiseNotYetImplemented(20170518203134,Expr);
   Ref:=TResolvedReference(Expr.CustomData);
   Decl:=Ref.Declaration;
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.OnExprEvalIdentifier Value=',Expr.Value,' Decl=',GetObjName(Decl));
+  {$ENDIF}
   C:=Decl.ClassType;
   if C=TPasConst then
     begin
     if (TPasConst(Decl).Expr<>nil)
         and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
       begin
-      Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,Flags);
+      if TPasConst(Decl).VarType<>nil then
+        begin
+        // typed const
+        ComputeElement(TPasConst(Decl).VarType,ResolvedType,[rcType]);
+        end
+      else
+        ResolvedType.BaseType:=btNone;
+      Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,Flags+[refConst]);
       if Result<>nil then
         begin
+        if (Result.Element<>nil) and (Result.Element<>TPasConst(Decl).Expr) then
+          Result:=Result.Clone;
         Result.IdentEl:=Decl;
+        if TPasConst(Decl).VarType<>nil then
+          begin
+          // typed const
+          if Result.Kind=revkInt then
+            case ResolvedType.BaseType of
+            btByte: TResEvalInt(Result).Typed:=reitByte;
+            btShortInt: TResEvalInt(Result).Typed:=reitShortInt;
+            btWord: TResEvalInt(Result).Typed:=reitWord;
+            btSmallInt: TResEvalInt(Result).Typed:=reitSmallInt;
+            btUIntSingle: TResEvalInt(Result).Typed:=reitUIntSingle;
+            btIntSingle: TResEvalInt(Result).Typed:=reitIntSingle;
+            btLongWord: TResEvalInt(Result).Typed:=reitLongWord;
+            btLongint: TResEvalInt(Result).Typed:=reitLongInt;
+            btUIntDouble: TResEvalInt(Result).Typed:=reitUIntDouble;
+            btIntDouble: TResEvalInt(Result).Typed:=reitIntDouble;
+            btInt64: TResEvalInt(Result).Typed:=reitNone; // default
+            else
+              ReleaseEvalValue(Result);
+              RaiseNotYetImplemented(20170624181050,TPasConst(Decl).VarType);
+            end;
+          end;
         exit;
         end;
       end;
@@ -7423,6 +7455,7 @@ var
   Decl: TPasElement;
   C: TClass;
   BuiltInProc: TResElDataBuiltInProc;
+  bt: TResolverBaseType;
 begin
   Result:=nil;
   if Params.Value.CustomData is TResolvedReference then
@@ -7438,19 +7471,137 @@ begin
       if Decl.CustomData is TResElDataBuiltInProc then
         begin
         BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
-        {$IFDEF VerbosePas2JS}
+        {$IFDEF VerbosePasResEval}
         writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
         {$ENDIF}
         case BuiltInProc.BuiltIn of
           bfLength: BI_Length_OnEval(BuiltInProc,Params,Result);
+          bfOrd: BI_Ord_OnEval(BuiltInProc,Params,Result);
           bfLow,bfHigh: BI_LowHigh_OnEval(BuiltInProc,Params,Result);
+          bfPred,bfSucc: BI_PredSucc_OnEval(BuiltInProc,Params,Result);
+        else
+          {$IFDEF VerbosePasResEval}
+          writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+          {$ENDIF}
+          RaiseNotYetImplemented(20170624192324,Params);
         end;
+        {$IFDEF VerbosePasResEval}
+        if Result<>nil then
+          writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
+        else
+          writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
+        {$ENDIF}
+        exit;
+        end
+      else if Decl.CustomData is TResElDataBaseType then
+        begin
+        // typecast to basetype
+        bt:=TResElDataBaseType(Decl.CustomData).BaseType;
+        Result:=EvalBaseTypeCast(Params,bt);
         end;
+      {$IFDEF VerbosePasResEval}
+      writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
+      {$ENDIF}
       end;
     end;
   if Flags=[] then ;
 end;
 
+function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
+  bt: TResolverBaseType): TResEvalvalue;
+var
+  Value: TResEvalValue;
+  Int: MaxPrecInt;
+  MinIntVal, MaxIntVal: int64;
+begin
+  Result:=nil;
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.EvalBaseTypeCast bt=',bt);
+  {$ENDIF}
+  Value:=Eval(Params.Params[0],[refAutoConst]);
+  if Value=nil then exit;
+  try
+    case Value.Kind of
+    revkInt:
+      begin
+      Int:=TResEvalInt(Value).Int;
+      if bt=btQWord then
+        begin
+        // int to qword
+        if (Int<0) then
+          fExprEvaluator.EmitRangeCheckConst(20170624195049,
+            Value.AsString,'0',IntToStr(High(qword)),Params);
+        {$R-}
+        Result:=TResEvalUInt.CreateValue(MaxPrecUInt(Int));
+        {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
+        end
+      else if bt in (btAllInteger-[btQWord]) then
+        begin
+        // int to int
+        GetIntegerRange(bt,MinIntVal,MaxIntVal);
+        if (Int<MinIntVal) or (Int>MaxIntVal) then
+          begin
+          fExprEvaluator.EmitRangeCheckConst(20170624194534,
+            Value.AsString,MinIntVal,MaxIntVal,Params);
+          {$R-}
+          case bt of
+            btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
+            btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);// ToDo: negative
+            btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
+            btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);// ToDo: negative
+            btUIntSingle: Result:=TResEvalInt.CreateValue(Int and MaskUIntSingle,reitUIntSingle);// ToDo: negative
+            btIntSingle: Result:=TResEvalInt.CreateValue(Int and MaskUIntSingle,reitIntSingle);// ToDo: negative
+            btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
+            btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);// ToDo: negative
+            btUIntDouble: Result:=TResEvalInt.CreateValue(Int and MaskUIntDouble,reitUIntDouble);// ToDo: negative
+            btIntDouble: Result:=TResEvalInt.CreateValue(Int and MaskUIntDouble,reitIntDouble);// ToDo: negative
+            btInt64: Result:=TResEvalInt.CreateValue(Int);
+          else
+            RaiseNotYetImplemented(20170624200109,Params);
+          end;
+          {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
+          end
+        else
+          begin
+          {$R-}
+          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(20170624200109,Params);
+          end;
+          {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
+          end;
+        exit;
+        end
+      else
+        begin
+        {$IFDEF VerbosePasResEval}
+        writeln('TPasResolver.OnExprEvalParams typecast int to ',bt);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170624194308,Params);
+        end;
+      end;
+    else
+      {$IFDEF VerbosePasResEval}
+      writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170624193436,Params);
+    end;
+  finally
+    ReleaseEvalValue(Value);
+  end;
+end;
+
 function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
   Store: boolean): TResEvalValue;
 // Important: Caller must free result if (Result<>nil) and (Result.Element=nil)
@@ -7461,6 +7612,9 @@ begin
   {$ENDIF}
   Result:=fExprEvaluator.Eval(Expr,Flags);
   if Result=nil then exit;
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.Eval Result=',Result.AsString);
+  {$ENDIF}
 
   if Store
       and (Expr.CustomData=nil)
@@ -7913,13 +8067,13 @@ begin
     exit(cIncompatible);
   Params:=TParamsExpr(Expr);
 
-  // first param: enum or char
+  // first param: bool, enum or char
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[]);
   Result:=cIncompatible;
   if rrfReadable in ParamResolved.Flags then
     begin
-    if ParamResolved.BaseType=btChar then
+    if ParamResolved.BaseType in (btAllBooleans+btAllChars) then
       Result:=cExact
     else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
       Result:=cExact;
@@ -7933,7 +8087,25 @@ end;
 procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
   Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
 begin
-  SetResolverIdentifier(ResolvedEl,btSmallInt,Proc.Proc,FBaseTypes[btSmallInt],[rrfReadable]);
+  SetResolverIdentifier(ResolvedEl,btLongint,Proc.Proc,FBaseTypes[btLongint],[rrfReadable]);
+end;
+
+procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out Evaluated: TResEvalValue);
+var
+  Param: TPasExpr;
+  Value: TResEvalValue;
+begin
+  Evaluated:=nil;
+  Param:=Params.Params[0];
+  Value:=Eval(Param,[]);
+  if Value=nil then exit;
+  try
+    Evaluated:=fExprEvaluator.OrdValue(Value,Params);
+  finally
+    if Evaluated=nil then
+      ReleaseEvalValue(Value);
+  end;
 end;
 
 function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
@@ -8261,8 +8433,22 @@ end;
 
 procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
   Params: TParamsExpr; out Evaluated: TResEvalValue);
+var
+  Param: TPasExpr;
 begin
-
+  //writeln('TPasResolver.BI_PredSucc_OnEval START');
+  Evaluated:=nil;
+  Param:=Params.Params[0];
+  Evaluated:=Eval(Param,[]);
+  //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
+  if Evaluated=nil then exit;
+  //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
+  if Evaluated.Element<>nil then
+    Evaluated:=Evaluated.Clone;
+  if Proc.BuiltIn=bfPred then
+    fExprEvaluator.PredValue(Evaluated,Params)
+  else
+    fExprEvaluator.SuccValue(Evaluated,Params);
 end;
 
 function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
@@ -9447,7 +9633,8 @@ begin
         @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,nil,nil,bfChr);
   if bfOrd in TheBaseProcs then
     AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
-        @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,nil,nil,bfOrd);
+        @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
+        @BI_Ord_OnEval,nil,bfOrd);
   if bfLow in TheBaseProcs then
     AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
         @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
@@ -9459,11 +9646,11 @@ begin
   if bfPred in TheBaseProcs then
     AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
         @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
-        nil,nil,bfPred);
+        @BI_PredSucc_OnEval,nil,bfPred);
   if bfSucc in TheBaseProcs then
     AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
         @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
-        nil,nil,bfSucc);
+        @BI_PredSucc_OnEval,nil,bfSucc);
   if bfStrProc in TheBaseProcs then
     AddBuiltInProc('Str','procedure Str(const var; var String)',
         @BI_StrProc_OnGetCallCompatibility,nil,nil,

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -50,10 +50,7 @@ interface
 
 uses
   Classes, SysUtils, AVL_Tree, PasTree, PScanner,
-  {$IFDEF VerbosePasAnalyzer}
-  PasResolveEval,
-  {$ENDIF}
-  PasResolver;
+  PasResolver, PasResolveEval;
 
 const
   nPAUnitNotUsed = 5023;

packages/fcl-passrc/src/paswrite.pp

@@ -215,7 +215,6 @@ procedure TPasWriter.WriteClass(AClass: TPasClassType);
 var
   i: Integer;
   Member: TPasElement;
-  InterfacesListPrefix: string;
   LastVisibility, CurVisibility: TPasMemberVisibility;
 begin
   PrepareDeclSection('type');
@@ -228,19 +227,7 @@ begin
     okInterface: wrt('interface');
   end;
   if Assigned(AClass.AncestorType) then
-    wrt('(' + AClass.AncestorType.Name);
-  if AClass.Interfaces.Count > 0 then
-  begin
-    if Assigned(AClass.AncestorType) then
-      InterfacesListPrefix:=', '
-    else
-      InterfacesListPrefix:='(';
-    wrt(InterfacesListPrefix + TPasType(AClass.Interfaces[0]).Name);
-    for i := 1 to AClass.Interfaces.Count - 1 do
-      wrt(', ' + TPasType(AClass.Interfaces[i]).Name);
-  end;
-  if Assigned(AClass.AncestorType) or (AClass.Interfaces.Count > 0) then
-    wrtln(')')
+    wrtln('(' + AClass.AncestorType.Name + ')')
   else
     wrtln;
   IncIndent;

packages/fcl-passrc/tests/tcresolver.pas

@@ -191,7 +191,7 @@ type
     Procedure TestByteRangeFail;
     Procedure TestCustomIntRangeFail;
     Procedure TestConstIntOperators;
-    // ToDo: TestConstBitwiseOps  3 and not 2, 3 and not longword(2)
+    Procedure TestConstBitwiseOps;
     Procedure TestConstBoolOperators;
 
     // strings
@@ -2243,6 +2243,25 @@ begin
   '  q:longword=not (5 or not 2);',
   '  r=low(word)+high(int64);',
   '  s=low(longint)+high(integer);',
+  '  t=succ(2)+pred(2);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestConstBitwiseOps;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=3;',
+  '  b=not a;',
+  '  c=not word(a);',
+  '  d=1 shl 2;',
+  '  e=13 shr 1;',
+  '  f=13 and 5;',
+  '  g=10 or 5;',
+  '  h=5 xor 7;',
   'begin']);
   ParseProgram;
   CheckResolverUnexpectedHints;
@@ -2261,6 +2280,7 @@ begin
   '  f=a<>b;',
   '  g=low(boolean) or high(boolean);',
   '  h=succ(false) or pred(true);',
+  '  i=ord(false)+ord(true);',
   'begin']);
   ParseProgram;
   CheckResolverUnexpectedHints;