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