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