libadalang_24.0.0_a1358075/src/libadalang-expr_eval.adb

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
--
--  Copyright (C) 2014-2022, AdaCore
--  SPDX-License-Identifier: Apache-2.0
--

with Ada.Exceptions;
with Ada.Strings.Wide_Wide_Unbounded; use Ada.Strings.Wide_Wide_Unbounded;

with GNATCOLL.GMP.Integers.Misc;

with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Common;   use Libadalang.Common;
with Libadalang.Sources;  use Libadalang.Sources;

package body Libadalang.Expr_Eval is

   use type GNATCOLL.GMP.Integers.Big_Integer;
   use type GNATCOLL.GMP.Rational_Numbers.Rational;

   function "+" (S : Wide_Wide_String) return Unbounded_Wide_Wide_String
                 renames To_Unbounded_Wide_Wide_String;

   function Create_Enum_Result
     (Expr_Type : LAL.Base_Type_Decl;
      Value     : LAL.Enum_Literal_Decl) return Eval_Result;
   --  Helper to create Eval_Result values to wrap enumeration literals

   function Create_Int_Result
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Big_Integer) return Eval_Result;
   function Create_Int_Result
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Integer) return Eval_Result;
   --  Helpers to create Eval_Result values to wrap integers

   function Create_Real_Result
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Rational) return Eval_Result;
   --  Helper to create Eval_Result values to wrap real numbers

   function Create_Bool_Result
     (Value : Boolean; N : LAL.Ada_Node'Class) return Eval_Result;
   --  Helper to create an Eval_Result with Enum_Lit_Kind which denotes
   --  the standard True or False literal decls from the standard Boolean
   --  type.
   --  todo: N is only used to access the fake free function P_Std_Entity.

   function Create_Result_From_Subst
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Big_Integer) return Eval_Result;
   --  Helper to create Eval_Result values from a given substitution value.
   --  The resulting Eval_Result's Kind will depend on the given Expr_Type:
   --   - If the Expr_Type is an rnum Type, the Kind will be Enum_Lit.
   --   - If the Expr_Type is a real Type, the Kind will be Real.
   --   - If the Expr_Type is a integer Type, the Kind will be Int.

   procedure Raise_To_N (Left, Right : Big_Integer; Result : out Big_Integer);
   --  Raise Left to the power of Right and return the result. If Right is too
   --  big or if it is negative, raise a Property_Error.

   function To_Integer (Big_Int : Big_Integer) return Integer;
   --  Convert a Big_Integer to an Integer

   function As_Bool (Self : Eval_Result) return Boolean;
   --  Return ``Self`` as a Boolean, if it is indeed of type
   --  ``Standard.Boolean``.

   function Is_Std_Char_Type (Node : LAL.Base_Type_Decl) return Boolean;
   --  Return whether ``Node`` is a standard character type

   ----------------------
   -- Is_Std_Char_Type --
   ----------------------

   function Is_Std_Char_Type (Node : LAL.Base_Type_Decl) return Boolean is
   begin
      --  Note: The condition below was previously implemented with
      --  a membership expression ``Node_Type in Std_Char_Type | ...``
      --  but Ada specifies that the predefined `"="` operator must be
      --  used in that case even if user-defined operator hides it.
      --  However, the predefined operator is too strict for us in
      --  this case: we want the comparison to discard irrelevant
      --  metadata (like how the node was retrieved) and so need to
      --  make sure the custom equality operators are called instead.

      return (Node = Node.P_Std_Char_Type
              or else Node = Node.P_Std_Wide_Char_Type
              or else Node = Node.P_Std_Wide_Wide_Char_Type);
   end Is_Std_Char_Type;

   ------------------------
   -- Create_Enum_Result --
   ------------------------

   function Create_Enum_Result
     (Expr_Type : LAL.Base_Type_Decl;
      Value     : LAL.Enum_Literal_Decl) return Eval_Result is
   begin
      return ((Kind        => Enum_Lit,
               Expr_Type   => Expr_Type,
               Enum_Result => Value));
   end Create_Enum_Result;

   -----------------------
   -- Create_Int_Result --
   -----------------------

   function Create_Int_Result
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Big_Integer) return Eval_Result is
   begin
      return Result : Eval_Result :=
        (Kind => Int, Expr_Type => Expr_Type, Int_Result => <>)
      do
         Result.Int_Result.Set (Value);
      end return;
   end Create_Int_Result;

   function Create_Int_Result
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Integer) return Eval_Result is
   begin
      return Create_Int_Result
         (Expr_Type, GNATCOLL.GMP.Integers.Make (Integer'Image (Value)));
   end Create_Int_Result;

   ------------------------
   -- Create_Real_Result --
   ------------------------

   function Create_Real_Result
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Rational) return Eval_Result is
   begin
      return Result : Eval_Result :=
        (Kind => Real, Expr_Type => Expr_Type, Real_Result => <>)
      do
         Result.Real_Result.Set (Value);
      end return;
   end Create_Real_Result;

   ------------------------------
   -- Create_Result_From_Subst --
   ------------------------------

   function Create_Result_From_Subst
     (Expr_Type  : LAL.Base_Type_Decl;
      Value      : Big_Integer) return Eval_Result is
   begin
      if Expr_Type.P_Is_Enum_Type then
         declare
            Base_Type_Decl : constant LAL.Type_Decl :=
               P_Base_Subtype (Expr_Type).As_Type_Decl;

            Enum_Def : constant LAL.Enum_Type_Def :=
               F_Type_Def (Base_Type_Decl).As_Enum_Type_Def;
         begin
            return Create_Enum_Result
              (Expr_Type,
               Child
                 (F_Enum_Literals (Enum_Def),
                  Positive (To_Integer (Value) + 1)).As_Enum_Literal_Decl);
         end;
      end if;
      return Create_Int_Result (Expr_Type, Value);
   end Create_Result_From_Subst;

   ------------------------
   -- Create_Bool_Result --
   ------------------------

   function Create_Bool_Result
     (Value : Boolean; N : LAL.Ada_Node'Class) return Eval_Result
   is
      --  Get the standard Boolean type declaration
      Bool_Type : constant LAL.Base_Type_Decl :=
         N.P_Std_Entity (+"Boolean").As_Base_Type_Decl;
   begin
      --  Get the enumerator value declaration corresponding to
      --  Result in Standard's Boolean.
      return Create_Enum_Result
        (Bool_Type,
         N.P_Std_Entity (+To_Text (Value'Image))
         .As_Enum_Literal_Decl);
   end Create_Bool_Result;

   ----------------
   -- Raise_To_N --
   ----------------

   procedure Raise_To_N (Left, Right : Big_Integer; Result : out Big_Integer)
   is
      N : Unsigned_Long;
   begin
      if Right < 0 then
         raise Property_Error with "Exponent must be positive";
      end if;

      begin
         N := Unsigned_Long'Value (Right.Image);
      exception
         when Constraint_Error =>
            raise Property_Error with "Exponent is too large";
      end;

      Result.Set (Left ** N);
   end Raise_To_N;

   ----------------
   -- To_Integer --
   ----------------

   function To_Integer (Big_Int : Big_Integer) return Integer is
   begin
      return Integer'Value (Big_Int.Image);
   exception
      when Constraint_Error =>
         raise Property_Error with "out of range big integer";
   end To_Integer;

   ---------------
   -- Expr_Eval --
   ---------------

   function Expr_Eval (E : LAL.Expr) return Eval_Result is
   begin
      return Expr_Eval_In_Env (E, (1 .. 0 => <>));
   end Expr_Eval;

   ----------------------
   -- Expr_Eval_In_Env --
   ----------------------

   function Expr_Eval_In_Env
     (E : LAL.Expr; Env : LAL.Substitution_Array) return Eval_Result
   is
      type Range_Attr is (Range_First, Range_Last);
      --  Reference to either the 'First or the 'Last attribute

      function Eval_Decl (D : LAL.Basic_Decl) return Eval_Result;
      --  Helper to evaluate the value associated to a declaration

      function Eval_Range_Attr
        (D : LAL.Ada_Node; A : Range_Attr) return Eval_Result;
      --  Helper to evaluate a 'First or 'Last attribute reference

      function Eval_Function_Attr
        (AR : LAL.Attribute_Ref; Args : LAL.Assoc_List) return Eval_Result;
      --  Helper to evaluate function attribute references

      function Eval_Array_Index
        (Call_Expr : LAL.Call_Expr; Index : LAL.Expr) return Eval_Result;
      --  Helper to evaluate array indexes

      function Eval_Array_Slice
        (Call_Expr : LAL.Call_Expr; Bounds : LAL.Bin_Op) return Eval_Result;
      --  Helper to evaluate function attribute references

      function Expr_Eval (E : LAL.Expr) return Eval_Result;
      --  Helper to evaluate the given expr in the current environment. Note
      --  that this is a regular function (instead of an expression function)
      --  to workaround a GNAT bug.

      ---------------
      -- Eval_Decl --
      ---------------

      function Eval_Decl (D : LAL.Basic_Decl) return Eval_Result is
      begin
         if D.Is_Null then
            raise Property_Error with "Invalid decl";
         end if;

         --  Check if the environment contains a substitution for the given
         --  basic declaration. If so, return the value from the substitution.
         for Subst of Env loop
            if From_Decl (Subst) = D then
               return Create_Result_From_Subst
                 (Expr_Type => Value_Type (Subst).As_Base_Type_Decl,
                  Value => To_Value (Subst));
            end if;
         end loop;

         case D.Kind is
            when Ada_Enum_Literal_Decl =>

               --  An enum literal declaration evaluates to itself
               return (Enum_Lit,
                       D.As_Enum_Literal_Decl.P_Enum_Type.As_Base_Type_Decl,
                       D.As_Enum_Literal_Decl);

            when Ada_Synthetic_Char_Enum_Lit =>

               --  A synthesized character enum declaration evaluates to the
               --  evaluation of its expression.
               return Expr_Eval
                 (D.As_Synthetic_Char_Enum_Lit.P_Expr.As_Expr);

            when Ada_Number_Decl =>

               --  A number declaration evaluates to the evaluation of its
               --  expression.
               return Expr_Eval (D.As_Number_Decl.F_Expr);

            when Ada_Object_Decl_Range =>
               if not D.As_Object_Decl.F_Renaming_Clause.Is_Null then
                  return Expr_Eval
                    (D.As_Object_Decl.F_Renaming_Clause
                     .F_Renamed_Object.As_Expr);
               elsif not D.As_Object_Decl.F_Default_Expr.Is_Null then
                  return Expr_Eval (D.As_Object_Decl.F_Default_Expr);
               else
                  raise Property_Error with "Object decl does not have "
                    & "a default expression nor a renaming clause.";
               end if;

            when Ada_Anonymous_Expr_Decl =>
               return Expr_Eval (D.As_Anonymous_Expr_Decl.F_Expr);

            when others =>
               raise Property_Error
                 with "Cannot eval decl " & D.Kind'Image;
         end case;
      end Eval_Decl;

      ---------------------
      -- Eval_Range_Attr --
      ---------------------

      function Eval_Range_Attr
        (D : LAL.Ada_Node; A : Range_Attr) return Eval_Result is
      begin
         if D.Is_Null then
            raise Property_Error with "Cannot resolve attribute prefix";
         end if;

         case D.Kind is
         when Ada_Name =>
            return Eval_Range_Attr
              (D.As_Name.P_Referenced_Decl.As_Ada_Node, A);

         when Ada_Type_Decl =>
            return Eval_Range_Attr
              (D.As_Type_Decl.F_Type_Def.As_Ada_Node, A);

         when Ada_Subtype_Decl =>
            declare
               Subtype_Indication : constant LAL.Subtype_Indication :=
                  D.As_Subtype_Decl.F_Subtype;
               Constraint         : constant LAL.Range_Constraint :=
                  Subtype_Indication.F_Constraint.As_Range_Constraint;

               --  If the subtype declaration has a range constraint, evaluate
               --  this constraint. Else, recurse on the designated subtype.
               Target : constant LAL.Ada_Node :=
                 (if Constraint.Is_Null
                  then Subtype_Indication.P_Designated_Type_Decl.As_Ada_Node
                  else Constraint.F_Range.F_Range.As_Ada_Node);
            begin
               return Eval_Range_Attr (Target, A);
            end;

         when Ada_Bin_Op_Range =>
            declare
               BO   : constant LAL.Bin_Op := D.As_Bin_Op;
               Expr : constant LAL.Expr :=
                 (case A is
                  when Range_First => BO.F_Left,
                  when Range_Last  => BO.F_Right);
            begin
               return Expr_Eval (Expr);
            end;

         when Ada_Type_Def =>
            case D.Kind is
            when Ada_Derived_Type_Def =>
               declare
                  Cst  : constant LAL.Constraint :=
                     D.As_Derived_Type_Def.F_Subtype_Indication.F_Constraint;

                  --  If the derived type declaration has a range constraint,
                  --  evaluate it. Otherwise, recurse on the base type.
                  Target : constant Ada_Node :=
                    (if Cst.Is_Null
                     then D.Parent.As_Base_Type_Decl.P_Base_Type.As_Ada_Node
                     else Cst.As_Range_Constraint.F_Range.F_Range.As_Ada_Node);
               begin
                  return Eval_Range_Attr (Target, A);
               end;
            when Ada_Signed_Int_Type_Def =>
               return Eval_Range_Attr
                 (D.As_Signed_Int_Type_Def.F_Range.F_Range.As_Ada_Node, A);
            when Ada_Enum_Type_Def =>
               declare
                  Lits      : constant LAL.Enum_Literal_Decl_List :=
                    D.As_Enum_Type_Def.F_Enum_Literals;
                  Lit_Index : constant Positive :=
                    (case A is
                     when Range_First => Lits.First_Child_Index,
                     when Range_Last  => Lits.Last_Child_Index);
                  Char_Pos  : Natural;
               begin
                  if Is_Std_Char_Type (D.Parent.As_Base_Type_Decl) then
                     --  Due to how we define the Character type in our
                     --  artifical __standard unit (and its
                     --  Wide_Character and Wide_Wide_Character
                     --  variants), the 'First and 'Last attributes cannot
                     --  return an Enum_Literal_Decl since they are not
                     --  defined. In order to not fail the Eval_As_Int
                     --  function, we return the corresponding Integer
                     --  value instead.
                     Char_Pos :=
                       (case A is
                        when Range_First =>
                           Support.Text.Character_Type'Pos
                           (Support.Text.Character_Type'First),
                        when Range_Last  =>
                          (if D.P_Std_Char_Type
                              .As_Base_Type_Decl = D.Parent.As_Base_Type_Decl
                           then
                              Character'Pos (Character'Last)
                           elsif D.P_Std_Wide_Char_Type
                                 .As_Base_Type_Decl =
                                 D.Parent.As_Base_Type_Decl
                           then
                              Wide_Character'Pos (Wide_Character'Last)
                           else
                              Support.Text.Character_Type'Pos
                              (Support.Text.Character_Type'Last)));

                     return Create_Int_Result (D.Parent.As_Base_Type_Decl,
                                               Char_Pos);
                  else
                     return Eval_Decl (Lits.Child (Lit_Index).As_Basic_Decl);
                  end if;
               end;
            when Ada_Decimal_Fixed_Point_Def =>
               declare
                  Def : constant LAL.Decimal_Fixed_Point_Def :=
                     D.As_Decimal_Fixed_Point_Def;

                  Rng : constant LAL.Range_Spec := Def.F_Range;
               begin
                  --  If a range has been specified we simply recurse on it,
                  --  otherwise we need to manually compute its bounds using
                  --  the `digits` and `delta` values specified for this fixed
                  --  point type definition.
                  if Rng.Is_Null then
                     declare
                        Delta_Res : constant Eval_Result :=
                           Expr_Eval (Def.F_Delta);

                        Delta_Val : constant Double :=
                          (if Delta_Res.Kind in Real
                           then Delta_Res.Real_Result.To_Double
                           else raise Property_Error with
                              "delta must be real");

                        Digits_Res : constant Eval_Result :=
                           Expr_Eval (Def.F_Digits);

                        Digits_Val : constant Integer :=
                          (if Digits_Res.Kind in Int
                           then To_Integer (Digits_Res.Int_Result)
                           else raise Property_Error with
                              "digits must be an integer");

                        Bound : constant Double :=
                          (if Digits_Val > 0 and Delta_Val > 0.0
                           then (10.0 ** Digits_Val - 1.0) * Delta_Val
                           else raise Property_Error with
                              "delta and digits must be positive");
                     begin
                        return Result : Eval_Result :=
                          (Kind        => Real,
                           Expr_Type   => D.Parent.As_Base_Type_Decl,
                           Real_Result => <>)
                        do
                           Result.Real_Result.Set
                             (case A is
                              when Range_First => -Bound,
                              when Range_Last => Bound);
                        end return;
                     end;
                  else
                     return Eval_Range_Attr (Rng.F_Range.As_Ada_Node, A);
                  end if;
               end;
            when Ada_Ordinary_Fixed_Point_Def =>
               return Eval_Range_Attr
                 (D.As_Ordinary_Fixed_Point_Def.F_Range.F_Range.As_Ada_Node,
                  A);

            when others =>
               raise Property_Error with
                  "Cannot get " & A'Image & " attribute of type def "
                  & D.Kind'Image;
            end case;

         when Ada_Object_Decl =>
            declare
               Val    : constant Eval_Result := Eval_Decl (D.As_Basic_Decl);
               Typ    : constant LAL.Base_Type_Decl :=
                  D.As_Object_Decl.P_Type_Expression.P_Designated_Type_Decl;
               Result : Big_Integer;
            begin
               if Val.Kind /= String_Lit then
                  raise Property_Error with
                    "Cannot eval " & A'Image & " on " & Val.Kind'Image;
               end if;

               case A is
               when Range_First => Result.Set (GNATCOLL.GMP.Long (Val.First));
               when Range_Last => Result.Set (GNATCOLL.GMP.Long (Val.Last));
               end case;

               return Create_Int_Result (Typ, Result);
            end;

         when others =>
            raise Property_Error with
               "Cannot eval " & A'Image & " attribute of " & D.Kind'Image;
         end case;
      end Eval_Range_Attr;

      ------------------------
      -- Eval_Function_Attr --
      ------------------------

      function Eval_Function_Attr
        (AR : LAL.Attribute_Ref; Args : LAL.Assoc_List) return Eval_Result
      is
         Attr : constant LAL.Identifier := AR.F_Attribute;
         Name : constant Wide_Wide_String :=
            Canonicalize (Attr.Text).Symbol;
      begin
         if Name in "min" | "max" then
            if Args.Is_Null or else Args.Children_Count /= 2 then
               raise Property_Error with
                  "'Min/'Max require exactly two arguments";
            end if;

            declare
               Typ   : constant Base_Type_Decl :=
                 AR.F_Prefix.P_Name_Designated_Type;
               Val_1 : constant Eval_Result :=
                 Expr_Eval (Args.Child (1).As_Param_Assoc.F_R_Expr);
               Val_2 : constant Eval_Result :=
                 Expr_Eval (Args.Child (2).As_Param_Assoc.F_R_Expr);
            begin
               if Val_1.Kind /= Val_2.Kind then
                  raise Property_Error with
                     "Inconsistent inputs for 'Min/'Max";
               end if;

               case Val_1.Kind is
                  when Int =>
                     if Name = "min" then
                        return Create_Int_Result
                          (Typ,
                           Eval_Result'
                             (if Val_1.Int_Result < Val_2.Int_Result
                              then Val_1 else Val_2).Int_Result);
                     else
                        return Create_Int_Result
                          (Typ,
                           Eval_Result'
                             (if Val_1.Int_Result > Val_2.Int_Result
                              then Val_1 else Val_2).Int_Result);
                     end if;
                  when Real =>
                     if Name = "min" then
                        return Create_Real_Result
                          (Typ,
                           Eval_Result'
                             (if Val_1.Real_Result < Val_2.Real_Result
                              then Val_1 else Val_2).Real_Result);
                     else
                        return Create_Real_Result
                          (Typ,
                           Eval_Result'
                             (if Val_1.Real_Result > Val_2.Real_Result
                              then Val_1 else Val_2).Real_Result);
                     end if;
                  when others =>
                     raise Property_Error with
                        "'Min/'Max not applicable on enum types";
               end case;
            end;
         elsif Name in "succ" | "pred" then
            if Args.Is_Null or else Args.Children_Count /= 1 then
               raise Property_Error with
                  "'Pred/'Succ require exactly one argument";
            end if;

            declare
               Typ      : constant Base_Type_Decl :=
                 AR.F_Prefix.P_Name_Designated_Type;
               Val      : constant Eval_Result :=
                 Expr_Eval (Args.Child (1).As_Param_Assoc.F_R_Expr);
               Enum_Val : Enum_Literal_Decl;
            begin
               case Val.Kind is
               when Int =>
                  --  TODO??? Properly handle modular types
                  return Create_Int_Result
                    (Typ,
                     (if Name = "succ"
                      then Val.Int_Result + 1
                      else Val.Int_Result - 1));
               when Real =>
                  raise Property_Error with
                     "'Pred/'Succ not applicable to reals";
               when others =>
                  Enum_Val := Ada_Node'
                    (if Name = "succ"
                     then Val.Enum_Result.Next_Sibling
                     else Val.Enum_Result.Previous_Sibling)
                    .As_Enum_Literal_Decl;

                  if Enum_Val.Is_Null then
                     raise Property_Error with
                       "out of bounds 'Pred/'Succ on enum";
                  end if;
                  return Create_Enum_Result (Typ, Enum_Val);
               end case;
            end;
         elsif Name in "val" then
            if Args.Is_Null or Args.Children_Count /= 1 then
               raise Property_Error with
                  "'Val require exactly one argument";
            end if;

            declare
               Typ      : constant Base_Type_Decl :=
                 AR.F_Prefix.P_Name_Designated_Type;
               Val      : constant Eval_Result :=
                 Expr_Eval (Args.Child (1).As_Param_Assoc.F_R_Expr);
            begin
               if Val.Kind /= Int then
                  raise Property_Error with
                     "'Val expects an integer argument";
               end if;

               if Typ.P_Is_Int_Type then
                  return Create_Int_Result (Typ, Val.Int_Result);
               elsif Typ.P_Is_Enum_Type then
                  declare
                     Index : constant Integer :=
                        To_Integer (Val.Int_Result);

                     Enum_Val : Enum_Literal_Decl :=
                        No_Enum_Literal_Decl;

                     Root_Type : constant LAL.Base_Type_Decl :=
                        Typ.P_Root_Type;
                  begin
                     if Index > -1 then
                        if (Index <= Character'Pos (Character'Last)
                            and then Root_Type = Typ.P_Std_Char_Type)
                          or else (Index <= Wide_Character'Pos
                                            (Wide_Character'Last)
                                   and then Root_Type =
                                            Typ.P_Std_Wide_Char_Type)
                          or else Root_Type = Typ.P_Std_Wide_Wide_Char_Type
                          --  Do not need to check for Wide_Wide_Character'Last
                          --  here, a runtime exception will be raised if Index
                          --  is out of range.
                        then
                           --  Due to how we define the Character type in our
                           --  artifical __standard unit (and its
                           --  Wide_Character and Wide_Wide_Character
                           --  variants), the 'Val attribute cannot return an
                           --  Enum_Literal_Decl since they are not defined. In
                           --  order to not fail the Eval_As_Int function, we
                           --  return the corresponding Integer value instead.
                           return Create_Int_Result (Typ, Val.Int_Result);
                        end if;

                        Enum_Val := Child
                           (Root_Type.As_Type_Decl.F_Type_Def.As_Enum_Type_Def
                            .F_Enum_Literals, Index + 1).As_Enum_Literal_Decl;
                     end if;

                     if Enum_Val.Is_Null then
                        raise Property_Error with
                          "out of bounds 'Val on enum";
                     end if;

                     return Create_Enum_Result (Typ, Enum_Val);
                  end;
               else
                  raise Property_Error with
                     "'Val only applicable to scalar types";
               end if;
            end;
         elsif Name in "pos" then
            if Args.Is_Null or Args.Children_Count /= 1 then
               raise Property_Error with
                  "'Pos require exactly one argument";
            end if;

            declare
               Typ      : constant Base_Type_Decl :=
                  AR.F_Prefix.P_Name_Designated_Type;
               Ret_Typ  : constant Base_Type_Decl :=
                  AR.P_Universal_Int_Type.As_Base_Type_Decl;
               Val      : constant Eval_Result :=
                  Expr_Eval (Args.Child (1).As_Param_Assoc.F_R_Expr);
            begin
               if Typ.P_Is_Int_Type then
                  if Val.Kind /= Int then
                     raise Property_Error with
                        "'Pos expects an integer argument";
                  end if;

                  --  The evaluator doesn't check if Pos argument is in the
                  --  range of Typ, i.e., illegal code such as:
                  --    Positive'Pos (-2)
                  --  will return -2.

                  return Create_Int_Result (Ret_Typ, Val.Int_Result);
               elsif Typ.P_Is_Enum_Type then
                  case Val.Kind is
                  when Int =>
                     return Create_Int_Result (Ret_Typ, Val.Int_Result);
                     --  This case allows to support Character enum literals
                  when Enum_Lit =>
                     return Create_Int_Result
                       (Ret_Typ, Val.Enum_Result.P_Enum_Rep);
                  when others =>
                     raise Property_Error with
                        "'Pos expects an argument of a discrete type";
                  end case;
               else
                  raise Property_Error with
                     "'Pos only applicable to discrete types";
               end if;
            end;
         elsif Name in "length" then

            --  Current support of 'Length only works on Strings (Character
            --  arrays). TODO??? Add support for all array types, including
            --  multidimensional ones.

            if not Args.Is_Null then
               raise Property_Error with
                  "'Length require no argument";
            end if;
            --  Not true for multidimensional arrays. 'Length attribute can
            --  take one argument standing for the Nth dimension of the
            --  array length is requested.

            declare
               Typ    : constant Base_Type_Decl :=
                  AR.F_Prefix.P_Name_Designated_Type;
               Val    : constant Eval_Result :=
                  Expr_Eval
                    (AR.F_Prefix.P_Referenced_Decl
                     .As_Object_Decl.F_Default_Expr);
               Result : Big_Integer;
            begin
               if Val.Kind /= String_Lit then
                  raise Property_Error with
                     "'Length expects a string argument";
               end if;

               Result.Set (GNATCOLL.GMP.Long (Length (As_String (Val))));

               return Create_Int_Result (Typ, Result);
            end;
         else
            raise Property_Error
              with "Unhandled attribute ref: " & Image (Attr.Text);
         end if;
      end Eval_Function_Attr;

      ----------------------
      -- Eval_Array_Index --
      ----------------------

      function Eval_Array_Index
        (Call_Expr : LAL.Call_Expr; Index : LAL.Expr) return Eval_Result
      is
         Array_Val : constant Eval_Result :=
            Eval_Decl (Call_Expr.P_Referenced_Decl);
         Index_Val : constant Eval_Result := Expr_Eval (Index);

         use GNATCOLL.GMP.Integers.Misc;
      begin
         if Array_Val.Kind = String_Lit then
            declare
               Str   : constant Unbounded_Text_Type := As_String (Array_Val);
               Index : constant Integer :=
                  Integer (As_Signed_Long (Index_Val.Int_Result));
            begin
               return Create_Int_Result
                 (Call_Expr.P_Expression_Type.P_Comp_Type,
                  Wide_Wide_Character'Pos (Element (Str, Index)));
            end;
         else
            raise Property_Error with
               "Cannot eval array index of kind " & Array_Val.Kind'Image;
         end if;
      end Eval_Array_Index;

      ----------------------
      -- Eval_Array_Slice --
      ----------------------

      function Eval_Array_Slice
        (Call_Expr : LAL.Call_Expr; Bounds : LAL.Bin_Op) return Eval_Result
      is
         Array_Val : constant Eval_Result :=
            Eval_Decl (Call_Expr.P_Referenced_Decl);
         First_Val : constant Eval_Result := Expr_Eval (Bounds.F_Left);
         Last_Val  : constant Eval_Result := Expr_Eval (Bounds.F_Right);

         use GNATCOLL.GMP.Integers.Misc;
      begin
         if Array_Val.Kind = String_Lit then
            declare
               Str   : Unbounded_Text_Type := As_String (Array_Val);
               First : constant Integer :=
                  Integer (As_Signed_Long (First_Val.Int_Result));
               Last  : constant Integer :=
                  Integer (As_Signed_Long (Last_Val.Int_Result));
               Len   : constant Positive := Length (Str);

            begin
               if First < Last then
                  --  Adjust Str regarding to requested bounds
                  Delete (Str, Len - (Array_Val.Last - Last - 1), Len);
                  Delete (Str, 1, First - Array_Val.First);
               else
                  --  The empty string
                  Delete (Str, 1, Len);
               end if;
               return (String_Lit, Call_Expr.P_Expression_Type,
                       Str, First, Last);
            end;
         else
            raise Property_Error with
               "Cannot eval array slide of kind " & Array_Val.Kind'Image;
         end if;
      end Eval_Array_Slice;

      ---------------
      -- Expr_Eval --
      ---------------

      function Expr_Eval (E : LAL.Expr) return Eval_Result is
      begin
         return Expr_Eval_In_Env (E, Env);
      end Expr_Eval;

   begin
      --  Processings on invalid Ada sources may lead to calling Expr_Eval on a
      --  null node. In this case, regular Ada runtime checks in code below
      --  will trigger a Constraint_Error, while we want here to propagate
      --  Property_Error exceptions on invalid code. So do the check ourselves.

      if E.Is_Null then
         raise Property_Error with "attempt to evaluate a null node";
      end if;

      case E.Kind is
         when Ada_Identifier | Ada_Dotted_Name =>
            return Eval_Decl (E.As_Name.P_Referenced_Decl);

         when Ada_Char_Literal =>
            declare
               Char      : constant LAL.Char_Literal := E.As_Char_Literal;
               Node_Type : constant LAL.Base_Type_Decl :=
                  Char.P_Expression_Type.P_Root_Type;
            begin
               --  A character literal is an enum value like any other and so
               --  its value should be its position in the enum. However, due
               --  to how we define our artificial __standard unit, this
               --  assumption does not hold for the Character type and its
               --  variants (Wide_Character, etc.) as they are not defined in
               --  their exact shape. We must therefore implement a specific
               --  path to handle them here.
               if Is_Std_Char_Type (Node_Type) then
                  --  Note that Langkit_Support's Character_Type is a
                  --  Wide_Wide_Character which can therefore also be used to
                  --  handle the Character and Wide_Character types.
                  return Create_Int_Result
                    (Char.P_Expression_Type,
                     Support.Text.Character_Type'Pos
                       (Char.P_Denoted_Value));
               else
                  --  If it's not a standard character type, evaluate it just
                  --  as any other enum literal.
                  return Eval_Decl (Char.P_Referenced_Decl);
               end if;
            end;

         when Ada_Int_Literal =>
            return (Int,
                    E.P_Universal_Int_Type.As_Base_Type_Decl,
                    E.As_Int_Literal.P_Denoted_Value);

         when Ada_Real_Literal =>
            return Result : Eval_Result :=
              (Kind        => Real,
               Expr_Type   => E.P_Universal_Real_Type.As_Base_Type_Decl,
               Real_Result => <>)
            do
               Decode_Real_Literal (E.Text, Result.Real_Result);
            end return;

         when Ada_String_Literal =>
            declare
               Val : constant Unbounded_Text_Type :=
                  +E.As_String_Literal.P_Denoted_Value;
            begin
               return (String_Lit, E.P_Expression_Type, Val, 1, Length (Val));
            end;

         when Ada_Membership_Expr =>
            declare
               MB        : constant LAL.Membership_Expr :=
                  E.As_Membership_Expr;

               Result    : Boolean := False;
               Op        : constant LAL.Op := F_Op (MB);
               Alts      : constant LAL.Expr_Alternatives_List :=
                  F_Membership_Exprs (MB);

               Choice_Value : constant Big_Integer := As_Int
                 (Expr_Eval (F_Expr (MB)));
            begin
               for C of Alts.Children loop
                  Result := Result or else P_Choice_Match (C, Choice_Value);
               end loop;

               if Op.Kind = Ada_Op_Not_In then
                  Result := not Result;
               end if;

               return Create_Bool_Result (Result, E.As_Ada_Node);
            end;

         when Ada_Relation_Op =>
            declare
               function Bool (X : Boolean; N : LAL.Ada_Node'Class := E)
                  return Eval_Result renames Create_Bool_Result;

               BO : constant LAL.Bin_Op := E.As_Bin_Op;
               Op : constant LAL.Op := BO.F_Op;
               L  : constant Eval_Result := Expr_Eval (BO.F_Left);
               R  : constant Eval_Result := Expr_Eval (BO.F_Right);
            begin
               if L.Kind /= R.Kind then
                  raise Property_Error with "Unsupported type discrepancy";
               end if;

               case R.Kind is
               when Int =>
                  case Op.Kind is
                  when Ada_Op_Eq =>
                     return Bool (L.Int_Result = R.Int_Result);
                  when Ada_Op_Neq =>
                     return Bool (L.Int_Result /= R.Int_Result);
                  when Ada_Op_Lt =>
                     return Bool (L.Int_Result < R.Int_Result);
                  when Ada_Op_Lte =>
                     return Bool (L.Int_Result <= R.Int_Result);
                  when Ada_Op_Gt =>
                     return Bool (L.Int_Result > R.Int_Result);
                  when Ada_Op_Gte =>
                     return Bool (L.Int_Result >= R.Int_Result);
                  when others =>
                     raise Program_Error with "Impossible path";
                  end case;

               when Real =>
                  case Op.Kind is
                  when Ada_Op_Eq =>
                     return Bool (L.Real_Result = R.Real_Result);
                  when Ada_Op_Neq =>
                     return Bool (L.Real_Result /= R.Real_Result);
                  when Ada_Op_Lt =>
                     return Bool (L.Real_Result < R.Real_Result);
                  when Ada_Op_Lte =>
                     return Bool (L.Real_Result <= R.Real_Result);
                  when Ada_Op_Gt =>
                     return Bool (L.Real_Result > R.Real_Result);
                  when Ada_Op_Gte =>
                     return Bool (L.Real_Result >= R.Real_Result);
                  when others =>
                     raise Program_Error with "Impossible path";
                  end case;

               when Enum_Lit =>
                  case Op.Kind is
                  when Ada_Op_Eq =>
                     return Bool (L.Enum_Result = R.Enum_Result);
                  when Ada_Op_Neq =>
                     return Bool (L.Enum_Result /= R.Enum_Result);
                  when others =>
                     raise Property_Error with
                        "Unhandled relation operator on enum values: "
                        & Op.Kind'Image;
                  end case;

               when String_Lit =>
                  case Op.Kind is
                  when Ada_Op_Eq =>
                     return Bool
                       (Langkit_Support.Text."="
                         (L.String_Result, R.String_Result));
                  when Ada_Op_Neq =>
                     return Bool
                       (Langkit_Support.Text."/="
                         (L.String_Result, R.String_Result));
                  when others =>
                     raise Property_Error with
                        "Unhandled relation operator on string values: "
                        & Op.Kind'Image;
                  end case;
               end case;
            end;

         when Ada_Bin_Op =>
            declare
               BO : constant LAL.Bin_Op := E.As_Bin_Op;
               Op : constant LAL.Op := BO.F_Op;
               L  : constant Eval_Result := Expr_Eval (BO.F_Left);
               R  : constant Eval_Result := Expr_Eval (BO.F_Right);
            begin
               if L.Kind /= R.Kind then
                  if L.Kind = Int and then R.Kind = Real
                    and then Op.Kind = Ada_Op_Mult
                  then
                     declare
                        Result : Rational;
                        Left : Rational;
                     begin
                        Left.Set (L.Int_Result);
                        Result.Set (Left * R.Real_Result);
                        return Create_Real_Result (R.Expr_Type, Result);
                     end;
                  elsif L.Kind = Real and then R.Kind = Int
                    and then Op.Kind = Ada_Op_Mult
                  then
                     declare
                        Result : Rational;
                        Right : Rational;
                     begin
                        Right.Set (R.Int_Result);
                        Result.Set (L.Real_Result * Right);
                        return Create_Real_Result (L.Expr_Type, Result);
                     end;
                  elsif L.Kind = Real and then R.Kind = Int
                    and then Op.Kind = Ada_Op_Div
                  then
                     declare
                        Result : Rational;
                        Right : Rational;
                     begin
                        Right.Set (R.Int_Result);
                        Result.Set (L.Real_Result / Right);
                        return Create_Real_Result (L.Expr_Type, Result);
                     end;
                  elsif L.Kind = Real and then R.Kind = Int
                    and then Op.Kind = Ada_Op_Pow
                  then
                     declare
                        Result : Rational;
                     begin
                        Result.Set (L.Real_Result ** R.Int_Result);
                        return Create_Real_Result (L.Expr_Type, Result);
                     end;
                  else
                     raise Property_Error with "Unsupported type discrepancy";
                  end if;
               end if;

               case R.Kind is
               when Int =>
                  --  Handle arithmetic operators on Int values
                  declare
                     Result : Big_Integer;
                  begin
                     case Op.Kind is
                     when Ada_Op_Plus =>
                        Result.Set (L.Int_Result + R.Int_Result);
                     when Ada_Op_Minus =>
                        Result.Set (L.Int_Result - R.Int_Result);
                     when Ada_Op_Mult =>
                        Result.Set (L.Int_Result * R.Int_Result);
                     when Ada_Op_Div =>
                        if R.Int_Result = 0 then
                           raise Property_Error with "Division by zero";
                        end if;
                        Result.Set (L.Int_Result / R.Int_Result);
                     when Ada_Op_Pow =>
                        Raise_To_N (L.Int_Result, R.Int_Result, Result);
                     when others =>
                        raise Property_Error with
                           "Unhandled operator: " & Op.Kind'Image;
                     end case;

                     return Create_Int_Result (R.Expr_Type, Result);
                  end;

               when Real =>
                  --  Handle arithmetic operators on Real values
                  declare
                     Result : Rational;
                  begin
                     begin
                        case Op.Kind is
                        when Ada_Op_Plus =>
                           Result.Set (L.Real_Result + R.Real_Result);
                        when Ada_Op_Minus =>
                           Result.Set (L.Real_Result - R.Real_Result);
                        when Ada_Op_Mult =>
                           Result.Set (L.Real_Result * R.Real_Result);
                        when Ada_Op_Div =>
                           Result.Set (L.Real_Result / R.Real_Result);
                        when others =>
                           raise Property_Error with
                              "Unhandled operator: " & Op.Kind'Image;
                        end case;
                     exception
                        when Exc : Constraint_Error =>
                           raise Property_Error with
                              "Floating point computation error: "
                              & Ada.Exceptions.Exception_Message (Exc);
                     end;
                     return Create_Real_Result (R.Expr_Type, Result);
                  end;

               when Enum_Lit =>
                  --  Handle relational operators on boolean values
                  declare
                     LB        : constant Boolean := As_Bool (L);
                     RB        : constant Boolean := As_Bool (R);
                     Result    : Boolean;
                  begin
                     case Op.Kind is
                     when Ada_Op_And | Ada_Op_And_Then =>
                        Result := LB and then RB;
                     when Ada_Op_Or | Ada_Op_Or_Else =>
                        Result := LB or else RB;
                     when others =>
                        raise Property_Error with
                           "Wrong operator for boolean: " & Op.Kind'Image;
                     end case;

                     return Create_Bool_Result (Result, BO.As_Ada_Node);
                  end;

               when String_Lit =>
                  raise Property_Error with
                     "Wrong operator for string: " & Op.Kind'Image;
               end case;
            end;

         when Ada_Concat_Op =>
            declare
               CO            : constant LAL.Concat_Op := E.As_Concat_Op;
               Concat_Result : Unbounded_Text_Type;
               First         : Natural := 0;
            begin
               for I of CO.P_Operands loop
                  declare
                     ER : constant Eval_Result := Expr_Eval (I);
                  begin
                     if First = 0 then
                        First := ER.First;
                     end if;
                     Concat_Result := Concat_Result & ER.String_Result;
                  end;
               end loop;
               return
                 (String_Lit,
                  E.P_Expression_Type,
                  Concat_Result,
                  First,
                  First + Length (Concat_Result));
            end;

         when Ada_Un_Op =>
            declare
               UO           : constant LAL.Un_Op := E.As_Un_Op;
               Op           : constant LAL.Op := UO.F_Op;
               Operand_Val  : constant Eval_Result := Expr_Eval (UO.F_Expr);
               Operand_Type : LAL.Base_Type_Decl renames Operand_Val.Expr_Type;

               subtype Valid_Unop_Kind is Ada_Node_Kind_Type with
                  Static_Predicate => Valid_Unop_Kind in
                     Ada_Op_Minus | Ada_Op_Plus | Ada_Op_Abs | Ada_Op_Not;
               Op_Kind : constant Valid_Unop_Kind := Op.Kind;
               --  Parsers can only build unary operators with the above
               --  operations. Using a subtype here saves us from writing dead
               --  code.
            begin
               case Operand_Val.Kind is
               when Enum_Lit =>
                  --  Unary operators are not valid on enums. This is not a
                  --  legality check: since we process standard character types
                  --  as integers, this guard will not reject them, but at
                  --  least code below can assume we are dealing with integers
                  --  or reals.
                  raise Property_Error with
                     "Unary operator invalid on enumerations";

               when String_Lit =>
                  raise Property_Error with
                     "Unary operator invalid on strings";

               when Int =>
                  declare
                     Operand : Big_Integer renames Operand_Val.Int_Result;
                     Result  : Big_Integer;
                  begin
                     case Op_Kind is
                     when Ada_Op_Minus =>
                        Result.Set (-Operand);
                     when Ada_Op_Plus =>
                        Result.Set (Operand);
                     when Ada_Op_Abs =>
                        Result.Set (abs Operand);
                     when Ada_Op_Not =>
                        --  TODO??? Here, we need to check that the operand
                        --  type is a modular type, and flip bits according to
                        --  its size.
                        raise Property_Error with
                           """not"" not implemented yet";
                     end case;
                     return Create_Int_Result (Operand_Type, Result);
                  end;

               when Real =>
                  declare
                     Operand : Rational renames Operand_Val.Real_Result;
                     Result  : Rational;
                  begin
                     begin
                        case Op_Kind is
                        when Ada_Op_Minus =>
                           Result.Set (-Operand);
                        when Ada_Op_Plus =>
                           Result.Set (Operand);
                        when Ada_Op_Abs =>
                           Result.Set (abs Operand);
                        when Ada_Op_Not =>
                           raise Property_Error with
                              "Invalid ""not"" operator for floating point"
                              & " value";
                        end case;
                     exception
                        when Exc : Constraint_Error =>
                           raise Property_Error with
                              "Floating point computation error: "
                              & Ada.Exceptions.Exception_Message (Exc);
                     end;
                     return Create_Real_Result (Operand_Type, Result);
                  end;
               end case;
            end;

         when Ada_Attribute_Ref =>
            declare
               AR   : constant LAL.Attribute_Ref := E.As_Attribute_Ref;
               Attr : constant LAL.Identifier := AR.F_Attribute;
               Name : constant Wide_Wide_String :=
                  Canonicalize (Attr.Text).Symbol;
            begin
               if Name = "first" then
                  return Eval_Range_Attr
                    (As_Ada_Node (AR.F_Prefix), Range_First);
               elsif Name = "last" then
                  return Eval_Range_Attr
                    (As_Ada_Node (AR.F_Prefix), Range_Last);
               else
                  return Eval_Function_Attr (AR, LAL.No_Assoc_List);
               end if;
            end;

         when Ada_Paren_Expr =>
            return Expr_Eval (E.As_Paren_Expr.F_Expr);

         when Ada_Call_Expr =>
            declare
               C               : constant Call_Expr := E.As_Call_Expr;
               S               : constant Ada_Node := C.F_Suffix;
               Arg             : Expr;
               Designated_Type : constant Base_Type_Decl :=
                  C.F_Name.P_Name_Designated_Type;
               C_Kind          : Call_Expr_Kind;
            begin
               --  Make sure that C's name designates a type and that C has
               --  exactly one argument.
               if C.F_Name.Kind in Ada_Attribute_Ref then
                  return Eval_Function_Attr
                    (C.F_Name.As_Attribute_Ref, S.As_Assoc_List);
               end if;

               --  Avoid displaying LAL's internal property errors on calls to
               --  P_Kind when evaluating invalid code.
               begin
                  C_Kind := C.P_Kind;
               exception
                  when Property_Error =>
                     raise Property_Error with
                        "Unhandled call expr: " & Image (E.Text);
               end;

               if C_Kind in Array_Index then
                  return Eval_Array_Index
                    (C, S.Child (1).As_Param_Assoc.F_R_Expr);
               elsif C_Kind in Array_Slice then
                  return Eval_Array_Slice
                    (C, S.As_Bin_Op);
               elsif Designated_Type.Is_Null
                  or else S.Is_Null
                  or else S.Children_Count /= 1
               then
                  raise Property_Error
                    with "Unhandled call expr: " & Image (E.Text);
               end if;

               Arg := S.Child (1).As_Param_Assoc.F_R_Expr;
               if Designated_Type.P_Is_Float_Type then
                  declare
                     Arg_Val : constant Eval_Result := Expr_Eval (Arg);
                     Result  : Rational;
                  begin
                     case Arg_Val.Kind is
                     when Int =>
                        Result.Set (Arg_Val.Int_Result);
                     when Real =>
                        Result.Set (Arg_Val.Real_Result);
                     when Enum_Lit =>
                        raise Property_Error with "Invalid enum argument";
                     when String_Lit =>
                        raise Property_Error with "Invalid string argument";
                     end case;
                     return Create_Real_Result (Designated_Type, Result);
                  end;

               elsif Designated_Type.P_Is_Int_Type then
                  declare
                     Arg_Val : constant Eval_Result := Expr_Eval (Arg);
                     Result  : Big_Integer;
                  begin
                     case Arg_Val.Kind is
                     when Int =>
                        Result.Set (Arg_Val.Int_Result);
                     when Real =>
                        Result.Set
                          (GNATCOLL.GMP.Long (Arg_Val.Real_Result.To_Double));
                     when Enum_Lit =>
                        raise Property_Error with "Invalid enum argument";
                     when String_Lit =>
                        raise Property_Error with "Invalid string argument";
                     end case;
                     return Create_Int_Result (Designated_Type, Result);
                  end;

               elsif Designated_Type.P_Is_Enum_Type then
                  declare
                     Arg_Val : constant Eval_Result := Expr_Eval (Arg);
                  begin
                     case Arg_Val.Kind is
                     when Int =>
                        raise Property_Error with "Invalid integer argument";
                     when Real =>
                        raise Property_Error with "Invalid real argument";
                     when Enum_Lit =>
                        --  Convert an enum to another enum: return Arg_Val
                        --  with its new type.
                        return Create_Enum_Result
                           (Designated_Type, Arg_Val.Enum_Result);
                     when String_Lit =>
                        raise Property_Error with "Invalid string argument";
                     end case;
                  end;

               else
                  raise Property_Error
                    with "Unhandled type conversion: " & Image (E.Text);
               end if;
            end;

         when others =>
            raise Property_Error with "Unhandled node: " & E.Kind'Img;
      end case;
   end Expr_Eval_In_Env;

   ------------
   -- As_Int --
   ------------

   function As_Int (Self : Eval_Result) return Big_Integer is
   begin
      return Result : Big_Integer do
         case Self.Kind is
            when Int =>
               Result.Set (Self.Int_Result);
            when Real =>
               raise Property_Error;
            when Enum_Lit =>
               declare
                  Pos : constant Natural := Self.Enum_Result.Child_Index;
               begin
                  Result.Set (GNATCOLL.GMP.Long (Pos));
               end;
            when String_Lit =>
               raise Property_Error;
         end case;
      end return;
   end As_Int;

   -------------
   -- As_Bool --
   -------------

   function As_Bool (Self : Eval_Result) return Boolean is
      Bool_Type   : LAL.Base_Type_Decl;
   begin
      case Self.Kind is
         when Enum_Lit =>
            Bool_Type :=
              Self.Enum_Result.P_Std_Entity (+"Boolean").As_Base_Type_Decl;
            if Self.Expr_Type /= Bool_Type then
               raise Property_Error with "Wrong type for enum for As_Bool";
            end if;
            return Self.Enum_Result.Text = "True";
         when others =>
            raise Property_Error with "Wrong value kind for As_Bool";
      end case;
   end As_Bool;

   ---------------
   -- As_String --
   ---------------

   function As_String (Self : Eval_Result) return Unbounded_Text_Type is
   begin
      case Self.Kind is
         when Int =>
            raise Property_Error;
         when Real =>
            raise Property_Error;
         when Enum_Lit =>
            raise Property_Error;
         when String_Lit =>
            return Self.String_Result;
      end case;
   end As_String;

   -----------
   -- Image --
   -----------

   function Image (Self : Eval_Result) return String is
   begin
      return "<Eval_Result "
        & Self.Kind'Image & " "
        & (case Self.Kind is
           when Int => Self.Int_Result.Image,
           when Real => Self.Real_Result.Image,
           when Enum_Lit => Self.Enum_Result.Image,
           when String_Lit => Encode (To_Text (Self.String_Result), "UTF-8"))
        & ">";
   end Image;

end Libadalang.Expr_Eval;