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