gcc/ada/g-awk.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T . A W K                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2000-2016, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Exceptions;
  33 with Ada.Text_IO;
  34 with Ada.Strings.Unbounded;
  35 with Ada.Strings.Fixed;
  36 with Ada.Strings.Maps;
  37 with Ada.Unchecked_Deallocation;
  38
  39 with GNAT.Directory_Operations;
  40 with GNAT.Dynamic_Tables;
  41 with GNAT.OS_Lib;
  42
  43 package body GNAT.AWK is
  44
  45    use Ada;
  46    use Ada.Strings.Unbounded;
  47
  48    -----------------------
  49    -- Local subprograms --
  50    -----------------------
  51
  52    --  The following two subprograms provide a functional interface to the
  53    --  two special session variables, that are manipulated explicitly by
  54    --  Finalize, but must be declared after Finalize to prevent static
  55    --  elaboration warnings.
  56
  57    function Get_Def return Session_Data_Access;
  58    procedure Set_Cur;
  59
  60    ----------------
  61    -- Split mode --
  62    ----------------
  63
  64    package Split is
  65
  66       type Mode is abstract tagged null record;
  67       --  This is the main type which is declared abstract. This type must be
  68       --  derived for each split style.
  69
  70       type Mode_Access is access Mode'Class;
  71
  72       procedure Current_Line (S : Mode; Session : Session_Type)
  73         is abstract;
  74       --  Split current line of Session using split mode S
  75
  76       ------------------------
  77       -- Split on separator --
  78       ------------------------
  79
  80       type Separator (Size : Positive) is new Mode with record
  81          Separators : String (1 .. Size);
  82       end record;
  83
  84       procedure Current_Line
  85         (S       : Separator;
  86          Session : Session_Type);
  87
  88       ---------------------
  89       -- Split on column --
  90       ---------------------
  91
  92       type Column (Size : Positive) is new Mode with record
  93          Columns : Widths_Set (1 .. Size);
  94       end record;
  95
  96       procedure Current_Line (S : Column; Session : Session_Type);
  97
  98    end Split;
  99
 100    procedure Free is new Unchecked_Deallocation
 101      (Split.Mode'Class, Split.Mode_Access);
 102
 103    ----------------
 104    -- File_Table --
 105    ----------------
 106
 107    type AWK_File is access String;
 108
 109    package File_Table is
 110       new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
 111    --  List of file names associated with a Session
 112
 113    procedure Free is new Unchecked_Deallocation (String, AWK_File);
 114
 115    -----------------
 116    -- Field_Table --
 117    -----------------
 118
 119    type Field_Slice is record
 120       First : Positive;
 121       Last  : Natural;
 122    end record;
 123    --  This is a field slice (First .. Last) in session's current line
 124
 125    package Field_Table is
 126       new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
 127    --  List of fields for the current line
 128
 129    --------------
 130    -- Patterns --
 131    --------------
 132
 133    --  Define all patterns style: exact string, regular expression, boolean
 134    --  function.
 135
 136    package Patterns is
 137
 138       type Pattern is abstract tagged null record;
 139       --  This is the main type which is declared abstract. This type must be
 140       --  derived for each patterns style.
 141
 142       type Pattern_Access is access Pattern'Class;
 143
 144       function Match
 145         (P       : Pattern;
 146          Session : Session_Type) return Boolean
 147       is abstract;
 148       --  Returns True if P match for the current session and False otherwise
 149
 150       procedure Release (P : in out Pattern);
 151       --  Release memory used by the pattern structure
 152
 153       --------------------------
 154       -- Exact string pattern --
 155       --------------------------
 156
 157       type String_Pattern is new Pattern with record
 158          Str  : Unbounded_String;
 159          Rank : Count;
 160       end record;
 161
 162       function Match
 163         (P       : String_Pattern;
 164          Session : Session_Type) return Boolean;
 165
 166       --------------------------------
 167       -- Regular expression pattern --
 168       --------------------------------
 169
 170       type Pattern_Matcher_Access is access Regpat.Pattern_Matcher;
 171
 172       type Regexp_Pattern is new Pattern with record
 173          Regx : Pattern_Matcher_Access;
 174          Rank : Count;
 175       end record;
 176
 177       function Match
 178         (P       : Regexp_Pattern;
 179          Session : Session_Type) return Boolean;
 180
 181       procedure Release (P : in out Regexp_Pattern);
 182
 183       ------------------------------
 184       -- Boolean function pattern --
 185       ------------------------------
 186
 187       type Callback_Pattern is new Pattern with record
 188          Pattern : Pattern_Callback;
 189       end record;
 190
 191       function Match
 192         (P       : Callback_Pattern;
 193          Session : Session_Type) return Boolean;
 194
 195    end Patterns;
 196
 197    procedure Free is new Unchecked_Deallocation
 198      (Patterns.Pattern'Class, Patterns.Pattern_Access);
 199
 200    -------------
 201    -- Actions --
 202    -------------
 203
 204    --  Define all action style : simple call, call with matches
 205
 206    package Actions is
 207
 208       type Action is abstract tagged null record;
 209       --  This is the main type which is declared abstract. This type must be
 210       --  derived for each action style.
 211
 212       type Action_Access is access Action'Class;
 213
 214       procedure Call
 215         (A       : Action;
 216          Session : Session_Type) is abstract;
 217       --  Call action A as required
 218
 219       -------------------
 220       -- Simple action --
 221       -------------------
 222
 223       type Simple_Action is new Action with record
 224          Proc : Action_Callback;
 225       end record;
 226
 227       procedure Call
 228         (A       : Simple_Action;
 229          Session : Session_Type);
 230
 231       -------------------------
 232       -- Action with matches --
 233       -------------------------
 234
 235       type Match_Action is new Action with record
 236          Proc : Match_Action_Callback;
 237       end record;
 238
 239       procedure Call
 240         (A       : Match_Action;
 241          Session : Session_Type);
 242
 243    end Actions;
 244
 245    procedure Free is new Unchecked_Deallocation
 246      (Actions.Action'Class, Actions.Action_Access);
 247
 248    --------------------------
 249    -- Pattern/Action table --
 250    --------------------------
 251
 252    type Pattern_Action is record
 253       Pattern : Patterns.Pattern_Access;  -- If Pattern is True
 254       Action  : Actions.Action_Access;    -- Action will be called
 255    end record;
 256
 257    package Pattern_Action_Table is
 258       new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50);
 259
 260    ------------------
 261    -- Session Data --
 262    ------------------
 263
 264    type Session_Data is record
 265       Current_File : Text_IO.File_Type;
 266       Current_Line : Unbounded_String;
 267       Separators   : Split.Mode_Access;
 268       Files        : File_Table.Instance;
 269       File_Index   : Natural := 0;
 270       Fields       : Field_Table.Instance;
 271       Filters      : Pattern_Action_Table.Instance;
 272       NR           : Natural := 0;
 273       FNR          : Natural := 0;
 274       Matches      : Regpat.Match_Array (0 .. 100);
 275       --  Latest matches for the regexp pattern
 276    end record;
 277
 278    procedure Free is
 279       new Unchecked_Deallocation (Session_Data, Session_Data_Access);
 280
 281    --------------
 282    -- Finalize --
 283    --------------
 284
 285    procedure Finalize (Session : in out Session_Type) is
 286    begin
 287       --  We release the session data only if it is not the default session
 288
 289       if Session.Data /= Get_Def then
 290          --  Release separators
 291
 292          Free (Session.Data.Separators);
 293
 294          Free (Session.Data);
 295
 296          --  Since we have closed the current session, set it to point now to
 297          --  the default session.
 298
 299          Set_Cur;
 300       end if;
 301    end Finalize;
 302
 303    ----------------
 304    -- Initialize --
 305    ----------------
 306
 307    procedure Initialize (Session : in out Session_Type) is
 308    begin
 309       Session.Data := new Session_Data;
 310
 311       --  Initialize separators
 312
 313       Session.Data.Separators :=
 314         new Split.Separator'(Default_Separators'Length, Default_Separators);
 315
 316       --  Initialize all tables
 317
 318       File_Table.Init  (Session.Data.Files);
 319       Field_Table.Init (Session.Data.Fields);
 320       Pattern_Action_Table.Init (Session.Data.Filters);
 321    end Initialize;
 322
 323    -----------------------
 324    -- Session Variables --
 325    -----------------------
 326
 327    Def_Session : Session_Type;
 328    Cur_Session : Session_Type;
 329
 330    ----------------------
 331    -- Private Services --
 332    ----------------------
 333
 334    function Always_True return Boolean;
 335    --  A function that always returns True
 336
 337    function Apply_Filters
 338      (Session : Session_Type) return Boolean;
 339    --  Apply any filters for which the Pattern is True for Session. It returns
 340    --  True if a least one filters has been applied (i.e. associated action
 341    --  callback has been called).
 342
 343    procedure Open_Next_File
 344      (Session : Session_Type);
 345    pragma Inline (Open_Next_File);
 346    --  Open next file for Session closing current file if needed. It raises
 347    --  End_Error if there is no more file in the table.
 348
 349    procedure Raise_With_Info
 350      (E       : Exceptions.Exception_Id;
 351       Message : String;
 352       Session : Session_Type);
 353    pragma No_Return (Raise_With_Info);
 354    --  Raises exception E with the message prepended with the current line
 355    --  number and the filename if possible.
 356
 357    procedure Read_Line (Session : Session_Type);
 358    --  Read a line for the Session and set Current_Line
 359
 360    procedure Split_Line (Session : Session_Type);
 361    --  Split session's Current_Line according to the session separators and
 362    --  set the Fields table. This procedure can be called at any time.
 363
 364    ----------------------
 365    -- Private Packages --
 366    ----------------------
 367
 368    -------------
 369    -- Actions --
 370    -------------
 371
 372    package body Actions is
 373
 374       ----------
 375       -- Call --
 376       ----------
 377
 378       procedure Call
 379         (A       : Simple_Action;
 380          Session : Session_Type)
 381       is
 382          pragma Unreferenced (Session);
 383       begin
 384          A.Proc.all;
 385       end Call;
 386
 387       ----------
 388       -- Call --
 389       ----------
 390
 391       procedure Call
 392         (A       : Match_Action;
 393          Session : Session_Type)
 394       is
 395       begin
 396          A.Proc (Session.Data.Matches);
 397       end Call;
 398
 399    end Actions;
 400
 401    --------------
 402    -- Patterns --
 403    --------------
 404
 405    package body Patterns is
 406
 407       -----------
 408       -- Match --
 409       -----------
 410
 411       function Match
 412         (P       : String_Pattern;
 413          Session : Session_Type) return Boolean
 414       is
 415       begin
 416          return P.Str = Field (P.Rank, Session);
 417       end Match;
 418
 419       -----------
 420       -- Match --
 421       -----------
 422
 423       function Match
 424         (P       : Regexp_Pattern;
 425          Session : Session_Type) return Boolean
 426       is
 427          use type Regpat.Match_Location;
 428       begin
 429          Regpat.Match
 430            (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
 431          return Session.Data.Matches (0) /= Regpat.No_Match;
 432       end Match;
 433
 434       -----------
 435       -- Match --
 436       -----------
 437
 438       function Match
 439         (P       : Callback_Pattern;
 440          Session : Session_Type) return Boolean
 441       is
 442          pragma Unreferenced (Session);
 443       begin
 444          return P.Pattern.all;
 445       end Match;
 446
 447       -------------
 448       -- Release --
 449       -------------
 450
 451       procedure Release (P : in out Pattern) is
 452          pragma Unreferenced (P);
 453       begin
 454          null;
 455       end Release;
 456
 457       -------------
 458       -- Release --
 459       -------------
 460
 461       procedure Release (P : in out Regexp_Pattern) is
 462          procedure Free is new Unchecked_Deallocation
 463            (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
 464       begin
 465          Free (P.Regx);
 466       end Release;
 467
 468    end Patterns;
 469
 470    -----------
 471    -- Split --
 472    -----------
 473
 474    package body Split is
 475
 476       use Ada.Strings;
 477
 478       ------------------
 479       -- Current_Line --
 480       ------------------
 481
 482       procedure Current_Line (S : Separator; Session : Session_Type) is
 483          Line   : constant String := To_String (Session.Data.Current_Line);
 484          Fields : Field_Table.Instance renames Session.Data.Fields;
 485          Seps   : constant Maps.Character_Set := Maps.To_Set (S.Separators);
 486
 487          Start  : Natural;
 488          Stop   : Natural;
 489
 490       begin
 491          --  First field start here
 492
 493          Start := Line'First;
 494
 495          --  Record the first field start position which is the first character
 496          --  in the line.
 497
 498          Field_Table.Increment_Last (Fields);
 499          Fields.Table (Field_Table.Last (Fields)).First := Start;
 500
 501          loop
 502             --  Look for next separator
 503
 504             Stop := Fixed.Index
 505               (Source => Line (Start .. Line'Last),
 506                Set    => Seps);
 507
 508             exit when Stop = 0;
 509
 510             Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
 511
 512             --  If separators are set to the default (space and tab) we skip
 513             --  all spaces and tabs following current field.
 514
 515             if S.Separators = Default_Separators then
 516                Start := Fixed.Index
 517                  (Line (Stop + 1 .. Line'Last),
 518                   Maps.To_Set (Default_Separators),
 519                   Outside,
 520                   Strings.Forward);
 521
 522                if Start = 0 then
 523                   Start := Stop + 1;
 524                end if;
 525
 526             else
 527                Start := Stop + 1;
 528             end if;
 529
 530             --  Record in the field table the start of this new field
 531
 532             Field_Table.Increment_Last (Fields);
 533             Fields.Table (Field_Table.Last (Fields)).First := Start;
 534
 535          end loop;
 536
 537          Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
 538       end Current_Line;
 539
 540       ------------------
 541       -- Current_Line --
 542       ------------------
 543
 544       procedure Current_Line (S : Column; Session : Session_Type) is
 545          Line   : constant String := To_String (Session.Data.Current_Line);
 546          Fields : Field_Table.Instance renames Session.Data.Fields;
 547          Start  : Positive := Line'First;
 548
 549       begin
 550          --  Record the first field start position which is the first character
 551          --  in the line.
 552
 553          for C in 1 .. S.Columns'Length loop
 554
 555             Field_Table.Increment_Last (Fields);
 556
 557             Fields.Table (Field_Table.Last (Fields)).First := Start;
 558
 559             Start := Start + S.Columns (C);
 560
 561             Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
 562
 563          end loop;
 564
 565          --  If there is some remaining character on the line, add them in a
 566          --  new field.
 567
 568          if Start - 1 < Line'Length then
 569
 570             Field_Table.Increment_Last (Fields);
 571
 572             Fields.Table (Field_Table.Last (Fields)).First := Start;
 573
 574             Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
 575          end if;
 576       end Current_Line;
 577
 578    end Split;
 579
 580    --------------
 581    -- Add_File --
 582    --------------
 583
 584    procedure Add_File
 585      (Filename : String;
 586       Session  : Session_Type)
 587    is
 588       Files : File_Table.Instance renames Session.Data.Files;
 589
 590    begin
 591       if OS_Lib.Is_Regular_File (Filename) then
 592          File_Table.Increment_Last (Files);
 593          Files.Table (File_Table.Last (Files)) := new String'(Filename);
 594       else
 595          Raise_With_Info
 596            (File_Error'Identity,
 597             "File " & Filename & " not found.",
 598             Session);
 599       end if;
 600    end Add_File;
 601
 602    procedure Add_File
 603      (Filename : String)
 604    is
 605
 606    begin
 607       Add_File (Filename, Cur_Session);
 608    end Add_File;
 609
 610    ---------------
 611    -- Add_Files --
 612    ---------------
 613
 614    procedure Add_Files
 615      (Directory             : String;
 616       Filenames             : String;
 617       Number_Of_Files_Added : out Natural;
 618       Session               : Session_Type)
 619    is
 620       use Directory_Operations;
 621
 622       Dir      : Dir_Type;
 623       Filename : String (1 .. 200);
 624       Last     : Natural;
 625
 626    begin
 627       Number_Of_Files_Added := 0;
 628
 629       Open (Dir, Directory);
 630
 631       loop
 632          Read (Dir, Filename, Last);
 633          exit when Last = 0;
 634
 635          Add_File (Filename (1 .. Last), Session);
 636          Number_Of_Files_Added := Number_Of_Files_Added + 1;
 637       end loop;
 638
 639       Close (Dir);
 640
 641    exception
 642       when others =>
 643          Raise_With_Info
 644            (File_Error'Identity,
 645             "Error scanning directory " & Directory
 646             & " for files " & Filenames & '.',
 647             Session);
 648    end Add_Files;
 649
 650    procedure Add_Files
 651      (Directory             : String;
 652       Filenames             : String;
 653       Number_Of_Files_Added : out Natural)
 654    is
 655
 656    begin
 657       Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session);
 658    end Add_Files;
 659
 660    -----------------
 661    -- Always_True --
 662    -----------------
 663
 664    function Always_True return Boolean is
 665    begin
 666       return True;
 667    end Always_True;
 668
 669    -------------------
 670    -- Apply_Filters --
 671    -------------------
 672
 673    function Apply_Filters
 674      (Session : Session_Type) return Boolean
 675    is
 676       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
 677       Results : Boolean := False;
 678
 679    begin
 680       --  Iterate through the filters table, if pattern match call action
 681
 682       for F in 1 .. Pattern_Action_Table.Last (Filters) loop
 683          if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
 684             Results := True;
 685             Actions.Call (Filters.Table (F).Action.all, Session);
 686          end if;
 687       end loop;
 688
 689       return Results;
 690    end Apply_Filters;
 691
 692    -----------
 693    -- Close --
 694    -----------
 695
 696    procedure Close (Session : Session_Type) is
 697       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
 698       Files   : File_Table.Instance renames Session.Data.Files;
 699
 700    begin
 701       --  Close current file if needed
 702
 703       if Text_IO.Is_Open (Session.Data.Current_File) then
 704          Text_IO.Close (Session.Data.Current_File);
 705       end if;
 706
 707       --  Release Filters table
 708
 709       for F in 1 .. Pattern_Action_Table.Last (Filters) loop
 710          Patterns.Release (Filters.Table (F).Pattern.all);
 711          Free (Filters.Table (F).Pattern);
 712          Free (Filters.Table (F).Action);
 713       end loop;
 714
 715       for F in 1 .. File_Table.Last (Files) loop
 716          Free (Files.Table (F));
 717       end loop;
 718
 719       File_Table.Set_Last (Session.Data.Files, 0);
 720       Field_Table.Set_Last (Session.Data.Fields, 0);
 721       Pattern_Action_Table.Set_Last (Session.Data.Filters, 0);
 722
 723       Session.Data.NR := 0;
 724       Session.Data.FNR := 0;
 725       Session.Data.File_Index := 0;
 726       Session.Data.Current_Line := Null_Unbounded_String;
 727    end Close;
 728
 729    ---------------------
 730    -- Current_Session --
 731    ---------------------
 732
 733    function Current_Session return not null access Session_Type is
 734    begin
 735       return Cur_Session.Self;
 736    end Current_Session;
 737
 738    ---------------------
 739    -- Default_Session --
 740    ---------------------
 741
 742    function Default_Session return not null access Session_Type is
 743    begin
 744       return Def_Session.Self;
 745    end Default_Session;
 746
 747    --------------------
 748    -- Discrete_Field --
 749    --------------------
 750
 751    function Discrete_Field
 752      (Rank    : Count;
 753       Session : Session_Type) return Discrete
 754    is
 755    begin
 756       return Discrete'Value (Field (Rank, Session));
 757    end Discrete_Field;
 758
 759    function Discrete_Field_Current_Session
 760      (Rank    : Count) return Discrete is
 761       function Do_It is new Discrete_Field (Discrete);
 762    begin
 763       return Do_It (Rank, Cur_Session);
 764    end Discrete_Field_Current_Session;
 765
 766    -----------------
 767    -- End_Of_Data --
 768    -----------------
 769
 770    function End_Of_Data
 771      (Session : Session_Type) return Boolean
 772    is
 773    begin
 774       return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
 775         and then End_Of_File (Session);
 776    end End_Of_Data;
 777
 778    function End_Of_Data
 779      return Boolean
 780    is
 781    begin
 782       return End_Of_Data (Cur_Session);
 783    end End_Of_Data;
 784
 785    -----------------
 786    -- End_Of_File --
 787    -----------------
 788
 789    function End_Of_File
 790      (Session : Session_Type) return Boolean
 791    is
 792    begin
 793       return Text_IO.End_Of_File (Session.Data.Current_File);
 794    end End_Of_File;
 795
 796    function End_Of_File
 797      return Boolean
 798    is
 799    begin
 800       return End_Of_File (Cur_Session);
 801    end End_Of_File;
 802
 803    -----------
 804    -- Field --
 805    -----------
 806
 807    function Field
 808      (Rank    : Count;
 809       Session : Session_Type) return String
 810    is
 811       Fields : Field_Table.Instance renames Session.Data.Fields;
 812
 813    begin
 814       if Rank > Number_Of_Fields (Session) then
 815          Raise_With_Info
 816            (Field_Error'Identity,
 817             "Field number" & Count'Image (Rank) & " does not exist.",
 818             Session);
 819
 820       elsif Rank = 0 then
 821
 822          --  Returns the whole line, this is what $0 does under Session_Type
 823
 824          return To_String (Session.Data.Current_Line);
 825
 826       else
 827          return Slice (Session.Data.Current_Line,
 828                        Fields.Table (Positive (Rank)).First,
 829                        Fields.Table (Positive (Rank)).Last);
 830       end if;
 831    end Field;
 832
 833    function Field
 834      (Rank    : Count) return String
 835    is
 836    begin
 837       return Field (Rank, Cur_Session);
 838    end Field;
 839
 840    function Field
 841      (Rank    : Count;
 842       Session : Session_Type) return Integer
 843    is
 844    begin
 845       return Integer'Value (Field (Rank, Session));
 846
 847    exception
 848       when Constraint_Error =>
 849          Raise_With_Info
 850            (Field_Error'Identity,
 851             "Field number" & Count'Image (Rank)
 852             & " cannot be converted to an integer.",
 853             Session);
 854    end Field;
 855
 856    function Field
 857      (Rank    : Count) return Integer
 858    is
 859    begin
 860       return Field (Rank, Cur_Session);
 861    end Field;
 862
 863    function Field
 864      (Rank    : Count;
 865       Session : Session_Type) return Float
 866    is
 867    begin
 868       return Float'Value (Field (Rank, Session));
 869
 870    exception
 871       when Constraint_Error =>
 872          Raise_With_Info
 873            (Field_Error'Identity,
 874             "Field number" & Count'Image (Rank)
 875             & " cannot be converted to a float.",
 876             Session);
 877    end Field;
 878
 879    function Field
 880      (Rank    : Count) return Float
 881    is
 882    begin
 883       return Field (Rank, Cur_Session);
 884    end Field;
 885
 886    ----------
 887    -- File --
 888    ----------
 889
 890    function File
 891      (Session : Session_Type) return String
 892    is
 893       Files : File_Table.Instance renames Session.Data.Files;
 894
 895    begin
 896       if Session.Data.File_Index = 0 then
 897          return "??";
 898       else
 899          return Files.Table (Session.Data.File_Index).all;
 900       end if;
 901    end File;
 902
 903    function File
 904      return String
 905    is
 906    begin
 907       return File (Cur_Session);
 908    end File;
 909
 910    --------------------
 911    -- For_Every_Line --
 912    --------------------
 913
 914    procedure For_Every_Line
 915      (Separators : String        := Use_Current;
 916       Filename   : String        := Use_Current;
 917       Callbacks  : Callback_Mode := None;
 918       Session    : Session_Type)
 919    is
 920       Quit : Boolean;
 921
 922    begin
 923       Open (Separators, Filename, Session);
 924
 925       while not End_Of_Data (Session) loop
 926          Read_Line (Session);
 927          Split_Line (Session);
 928
 929          if Callbacks in Only .. Pass_Through then
 930             declare
 931                Discard : Boolean;
 932             begin
 933                Discard := Apply_Filters (Session);
 934             end;
 935          end if;
 936
 937          if Callbacks /= Only then
 938             Quit := False;
 939             Action (Quit);
 940             exit when Quit;
 941          end if;
 942       end loop;
 943
 944       Close (Session);
 945    end For_Every_Line;
 946
 947    procedure For_Every_Line_Current_Session
 948      (Separators : String        := Use_Current;
 949       Filename   : String        := Use_Current;
 950       Callbacks  : Callback_Mode := None)
 951    is
 952       procedure Do_It is new For_Every_Line (Action);
 953    begin
 954       Do_It (Separators, Filename, Callbacks, Cur_Session);
 955    end For_Every_Line_Current_Session;
 956
 957    --------------
 958    -- Get_Line --
 959    --------------
 960
 961    procedure Get_Line
 962      (Callbacks : Callback_Mode := None;
 963       Session   : Session_Type)
 964    is
 965       Filter_Active : Boolean;
 966
 967    begin
 968       if not Text_IO.Is_Open (Session.Data.Current_File) then
 969          raise File_Error;
 970       end if;
 971
 972       loop
 973          Read_Line (Session);
 974          Split_Line (Session);
 975
 976          case Callbacks is
 977             when None =>
 978                exit;
 979
 980             when Only =>
 981                Filter_Active := Apply_Filters (Session);
 982                exit when not Filter_Active;
 983
 984             when Pass_Through =>
 985                Filter_Active := Apply_Filters (Session);
 986                exit;
 987          end case;
 988       end loop;
 989    end Get_Line;
 990
 991    procedure Get_Line
 992      (Callbacks : Callback_Mode := None)
 993    is
 994    begin
 995       Get_Line (Callbacks, Cur_Session);
 996    end Get_Line;
 997
 998    ----------------------
 999    -- Number_Of_Fields --
1000    ----------------------
1001
1002    function Number_Of_Fields
1003      (Session : Session_Type) return Count
1004    is
1005    begin
1006       return Count (Field_Table.Last (Session.Data.Fields));
1007    end Number_Of_Fields;
1008
1009    function Number_Of_Fields
1010      return Count
1011    is
1012    begin
1013       return Number_Of_Fields (Cur_Session);
1014    end Number_Of_Fields;
1015
1016    --------------------------
1017    -- Number_Of_File_Lines --
1018    --------------------------
1019
1020    function Number_Of_File_Lines
1021      (Session : Session_Type) return Count
1022    is
1023    begin
1024       return Count (Session.Data.FNR);
1025    end Number_Of_File_Lines;
1026
1027    function Number_Of_File_Lines
1028      return Count
1029    is
1030    begin
1031       return Number_Of_File_Lines (Cur_Session);
1032    end Number_Of_File_Lines;
1033
1034    ---------------------
1035    -- Number_Of_Files --
1036    ---------------------
1037
1038    function Number_Of_Files
1039      (Session : Session_Type) return Natural
1040    is
1041       Files : File_Table.Instance renames Session.Data.Files;
1042    begin
1043       return File_Table.Last (Files);
1044    end Number_Of_Files;
1045
1046    function Number_Of_Files
1047      return Natural
1048    is
1049    begin
1050       return Number_Of_Files (Cur_Session);
1051    end Number_Of_Files;
1052
1053    ---------------------
1054    -- Number_Of_Lines --
1055    ---------------------
1056
1057    function Number_Of_Lines
1058      (Session : Session_Type) return Count
1059    is
1060    begin
1061       return Count (Session.Data.NR);
1062    end Number_Of_Lines;
1063
1064    function Number_Of_Lines
1065      return Count
1066    is
1067    begin
1068       return Number_Of_Lines (Cur_Session);
1069    end Number_Of_Lines;
1070
1071    ----------
1072    -- Open --
1073    ----------
1074
1075    procedure Open
1076      (Separators : String       := Use_Current;
1077       Filename   : String       := Use_Current;
1078       Session    : Session_Type)
1079    is
1080    begin
1081       if Text_IO.Is_Open (Session.Data.Current_File) then
1082          raise Session_Error;
1083       end if;
1084
1085       if Filename /= Use_Current then
1086          File_Table.Init (Session.Data.Files);
1087          Add_File (Filename, Session);
1088       end if;
1089
1090       if Separators /= Use_Current then
1091          Set_Field_Separators (Separators, Session);
1092       end if;
1093
1094       Open_Next_File (Session);
1095
1096    exception
1097       when End_Error =>
1098          raise File_Error;
1099    end Open;
1100
1101    procedure Open
1102      (Separators : String       := Use_Current;
1103       Filename   : String       := Use_Current)
1104    is
1105    begin
1106       Open (Separators, Filename, Cur_Session);
1107    end Open;
1108
1109    --------------------
1110    -- Open_Next_File --
1111    --------------------
1112
1113    procedure Open_Next_File
1114      (Session : Session_Type)
1115    is
1116       Files : File_Table.Instance renames Session.Data.Files;
1117
1118    begin
1119       if Text_IO.Is_Open (Session.Data.Current_File) then
1120          Text_IO.Close (Session.Data.Current_File);
1121       end if;
1122
1123       Session.Data.File_Index := Session.Data.File_Index + 1;
1124
1125       --  If there are no mores file in the table, raise End_Error
1126
1127       if Session.Data.File_Index > File_Table.Last (Files) then
1128          raise End_Error;
1129       end if;
1130
1131       Text_IO.Open
1132         (File => Session.Data.Current_File,
1133          Name => Files.Table (Session.Data.File_Index).all,
1134          Mode => Text_IO.In_File);
1135    end Open_Next_File;
1136
1137    -----------
1138    -- Parse --
1139    -----------
1140
1141    procedure Parse
1142      (Separators : String       := Use_Current;
1143       Filename   : String       := Use_Current;
1144       Session    : Session_Type)
1145    is
1146       Filter_Active : Boolean;
1147       pragma Unreferenced (Filter_Active);
1148
1149    begin
1150       Open (Separators, Filename, Session);
1151
1152       while not End_Of_Data (Session) loop
1153          Get_Line (None, Session);
1154          Filter_Active := Apply_Filters (Session);
1155       end loop;
1156
1157       Close (Session);
1158    end Parse;
1159
1160    procedure Parse
1161      (Separators : String       := Use_Current;
1162       Filename   : String       := Use_Current)
1163    is
1164    begin
1165       Parse (Separators, Filename, Cur_Session);
1166    end Parse;
1167
1168    ---------------------
1169    -- Raise_With_Info --
1170    ---------------------
1171
1172    procedure Raise_With_Info
1173      (E       : Exceptions.Exception_Id;
1174       Message : String;
1175       Session : Session_Type)
1176    is
1177       function Filename return String;
1178       --  Returns current filename and "??" if this information is not
1179       --  available.
1180
1181       function Line return String;
1182       --  Returns current line number without the leading space
1183
1184       --------------
1185       -- Filename --
1186       --------------
1187
1188       function Filename return String is
1189          File : constant String := AWK.File (Session);
1190       begin
1191          if File = "" then
1192             return "??";
1193          else
1194             return File;
1195          end if;
1196       end Filename;
1197
1198       ----------
1199       -- Line --
1200       ----------
1201
1202       function Line return String is
1203          L : constant String := Natural'Image (Session.Data.FNR);
1204       begin
1205          return L (2 .. L'Last);
1206       end Line;
1207
1208    --  Start of processing for Raise_With_Info
1209
1210    begin
1211       Exceptions.Raise_Exception
1212         (E,
1213          '[' & Filename & ':' & Line & "] " & Message);
1214       raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1215    end Raise_With_Info;
1216
1217    ---------------
1218    -- Read_Line --
1219    ---------------
1220
1221    procedure Read_Line (Session : Session_Type) is
1222
1223       function Read_Line return String;
1224       --  Read a line in the current file. This implementation is recursive
1225       --  and does not have a limitation on the line length.
1226
1227       NR  : Natural renames Session.Data.NR;
1228       FNR : Natural renames Session.Data.FNR;
1229
1230       ---------------
1231       -- Read_Line --
1232       ---------------
1233
1234       function Read_Line return String is
1235          Buffer : String (1 .. 1_024);
1236          Last   : Natural;
1237
1238       begin
1239          Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1240
1241          if Last = Buffer'Last then
1242             return Buffer & Read_Line;
1243          else
1244             return Buffer (1 .. Last);
1245          end if;
1246       end Read_Line;
1247
1248    --  Start of processing for Read_Line
1249
1250    begin
1251       if End_Of_File (Session) then
1252          Open_Next_File (Session);
1253          FNR := 0;
1254       end if;
1255
1256       Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1257
1258       NR := NR + 1;
1259       FNR := FNR + 1;
1260    end Read_Line;
1261
1262    --------------
1263    -- Register --
1264    --------------
1265
1266    procedure Register
1267      (Field   : Count;
1268       Pattern : String;
1269       Action  : Action_Callback;
1270       Session : Session_Type)
1271    is
1272       Filters   : Pattern_Action_Table.Instance renames Session.Data.Filters;
1273       U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1274
1275    begin
1276       Pattern_Action_Table.Increment_Last (Filters);
1277
1278       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1279         (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1280          Action  => new Actions.Simple_Action'(Proc => Action));
1281    end Register;
1282
1283    procedure Register
1284      (Field   : Count;
1285       Pattern : String;
1286       Action  : Action_Callback)
1287    is
1288    begin
1289       Register (Field, Pattern, Action, Cur_Session);
1290    end Register;
1291
1292    procedure Register
1293      (Field   : Count;
1294       Pattern : GNAT.Regpat.Pattern_Matcher;
1295       Action  : Action_Callback;
1296       Session : Session_Type)
1297    is
1298       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1299
1300       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1301                     new Regpat.Pattern_Matcher'(Pattern);
1302    begin
1303       Pattern_Action_Table.Increment_Last (Filters);
1304
1305       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1306         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1307          Action  => new Actions.Simple_Action'(Proc => Action));
1308    end Register;
1309
1310    procedure Register
1311      (Field   : Count;
1312       Pattern : GNAT.Regpat.Pattern_Matcher;
1313       Action  : Action_Callback)
1314    is
1315    begin
1316       Register (Field, Pattern, Action, Cur_Session);
1317    end Register;
1318
1319    procedure Register
1320      (Field   : Count;
1321       Pattern : GNAT.Regpat.Pattern_Matcher;
1322       Action  : Match_Action_Callback;
1323       Session : Session_Type)
1324    is
1325       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1326
1327       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1328                     new Regpat.Pattern_Matcher'(Pattern);
1329    begin
1330       Pattern_Action_Table.Increment_Last (Filters);
1331
1332       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1333         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1334          Action  => new Actions.Match_Action'(Proc => Action));
1335    end Register;
1336
1337    procedure Register
1338      (Field   : Count;
1339       Pattern : GNAT.Regpat.Pattern_Matcher;
1340       Action  : Match_Action_Callback)
1341    is
1342    begin
1343       Register (Field, Pattern, Action, Cur_Session);
1344    end Register;
1345
1346    procedure Register
1347      (Pattern : Pattern_Callback;
1348       Action  : Action_Callback;
1349       Session : Session_Type)
1350    is
1351       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1352
1353    begin
1354       Pattern_Action_Table.Increment_Last (Filters);
1355
1356       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1357         (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1358          Action  => new Actions.Simple_Action'(Proc => Action));
1359    end Register;
1360
1361    procedure Register
1362      (Pattern : Pattern_Callback;
1363       Action  : Action_Callback)
1364    is
1365    begin
1366       Register (Pattern, Action, Cur_Session);
1367    end Register;
1368
1369    procedure Register
1370      (Action  : Action_Callback;
1371       Session : Session_Type)
1372    is
1373    begin
1374       Register (Always_True'Access, Action, Session);
1375    end Register;
1376
1377    procedure Register
1378      (Action  : Action_Callback)
1379    is
1380    begin
1381       Register (Action, Cur_Session);
1382    end Register;
1383
1384    -----------------
1385    -- Set_Current --
1386    -----------------
1387
1388    procedure Set_Current (Session : Session_Type) is
1389    begin
1390       Cur_Session.Data := Session.Data;
1391    end Set_Current;
1392
1393    --------------------------
1394    -- Set_Field_Separators --
1395    --------------------------
1396
1397    procedure Set_Field_Separators
1398      (Separators : String       := Default_Separators;
1399       Session    : Session_Type)
1400    is
1401    begin
1402       Free (Session.Data.Separators);
1403
1404       Session.Data.Separators :=
1405         new Split.Separator'(Separators'Length, Separators);
1406
1407       --  If there is a current line read, split it according to the new
1408       --  separators.
1409
1410       if Session.Data.Current_Line /= Null_Unbounded_String then
1411          Split_Line (Session);
1412       end if;
1413    end Set_Field_Separators;
1414
1415    procedure Set_Field_Separators
1416      (Separators : String       := Default_Separators)
1417    is
1418    begin
1419       Set_Field_Separators (Separators, Cur_Session);
1420    end Set_Field_Separators;
1421
1422    ----------------------
1423    -- Set_Field_Widths --
1424    ----------------------
1425
1426    procedure Set_Field_Widths
1427      (Field_Widths : Widths_Set;
1428       Session      : Session_Type)
1429    is
1430    begin
1431       Free (Session.Data.Separators);
1432
1433       Session.Data.Separators :=
1434         new Split.Column'(Field_Widths'Length, Field_Widths);
1435
1436       --  If there is a current line read, split it according to
1437       --  the new separators.
1438
1439       if Session.Data.Current_Line /= Null_Unbounded_String then
1440          Split_Line (Session);
1441       end if;
1442    end Set_Field_Widths;
1443
1444    procedure Set_Field_Widths
1445      (Field_Widths : Widths_Set)
1446    is
1447    begin
1448       Set_Field_Widths (Field_Widths, Cur_Session);
1449    end Set_Field_Widths;
1450
1451    ----------------
1452    -- Split_Line --
1453    ----------------
1454
1455    procedure Split_Line (Session : Session_Type) is
1456       Fields : Field_Table.Instance renames Session.Data.Fields;
1457    begin
1458       Field_Table.Init (Fields);
1459       Split.Current_Line (Session.Data.Separators.all, Session);
1460    end Split_Line;
1461
1462    -------------
1463    -- Get_Def --
1464    -------------
1465
1466    function Get_Def return Session_Data_Access is
1467    begin
1468       return Def_Session.Data;
1469    end Get_Def;
1470
1471    -------------
1472    -- Set_Cur --
1473    -------------
1474
1475    procedure Set_Cur is
1476    begin
1477       Cur_Session.Data := Def_Session.Data;
1478    end Set_Cur;
1479
1480 begin
1481    --  We have declared two sessions but both should share the same data.
1482    --  The current session must point to the default session as its initial
1483    --  value. So first we release the session data then we set current
1484    --  session data to point to default session data.
1485
1486    Free (Cur_Session.Data);
1487    Cur_Session.Data := Def_Session.Data;
1488 end GNAT.AWK;