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