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       Quit : Boolean;
 877
 878    begin
 879       Open (Separators, Filename, Session);
 880
 881       while not End_Of_Data (Session) loop
 882          Read_Line (Session);
 883          Split_Line (Session);
 884
 885          if Callbacks in Only .. Pass_Through then
 886             declare
 887                Discard : Boolean;
 888                pragma Unreferenced (Discard);
 889             begin
 890                Discard := Apply_Filters (Session);
 891             end;
 892          end if;
 893
 894          if Callbacks /= Only then
 895             Quit := False;
 896             Action (Quit);
 897             exit when Quit;
 898          end if;
 899       end loop;
 900
 901       Close (Session);
 902    end For_Every_Line;
 903
 904    --------------
 905    -- Get_Line --
 906    --------------
 907
 908    procedure Get_Line
 909      (Callbacks : Callback_Mode := None;
 910       Session   : Session_Type := Current_Session)
 911    is
 912       Filter_Active : Boolean;
 913
 914    begin
 915       if not Text_IO.Is_Open (Session.Data.Current_File) then
 916          raise File_Error;
 917       end if;
 918
 919       loop
 920          Read_Line (Session);
 921          Split_Line (Session);
 922
 923          case Callbacks is
 924
 925             when None =>
 926                exit;
 927
 928             when Only =>
 929                Filter_Active := Apply_Filters (Session);
 930                exit when not Filter_Active;
 931
 932             when Pass_Through =>
 933                Filter_Active := Apply_Filters (Session);
 934                exit;
 935
 936          end case;
 937       end loop;
 938    end Get_Line;
 939
 940    ----------------------
 941    -- Number_Of_Fields --
 942    ----------------------
 943
 944    function Number_Of_Fields
 945      (Session : Session_Type := Current_Session)
 946       return    Count
 947    is
 948    begin
 949       return Count (Field_Table.Last (Session.Data.Fields));
 950    end Number_Of_Fields;
 951
 952    --------------------------
 953    -- Number_Of_File_Lines --
 954    --------------------------
 955
 956    function Number_Of_File_Lines
 957      (Session : Session_Type := Current_Session)
 958       return    Count
 959    is
 960    begin
 961       return Count (Session.Data.FNR);
 962    end Number_Of_File_Lines;
 963
 964    ---------------------
 965    -- Number_Of_Files --
 966    ---------------------
 967
 968    function Number_Of_Files
 969      (Session : Session_Type := Current_Session)
 970       return    Natural
 971    is
 972       Files : File_Table.Instance renames Session.Data.Files;
 973
 974    begin
 975       return File_Table.Last (Files);
 976    end Number_Of_Files;
 977
 978    ---------------------
 979    -- Number_Of_Lines --
 980    ---------------------
 981
 982    function Number_Of_Lines
 983      (Session : Session_Type := Current_Session)
 984       return    Count
 985    is
 986    begin
 987       return Count (Session.Data.NR);
 988    end Number_Of_Lines;
 989
 990    ----------
 991    -- Open --
 992    ----------
 993
 994    procedure Open
 995      (Separators : String       := Use_Current;
 996       Filename   : String       := Use_Current;
 997       Session    : Session_Type := Current_Session)
 998    is
 999    begin
1000       if Text_IO.Is_Open (Session.Data.Current_File) then
1001          raise Session_Error;
1002       end if;
1003
1004       if Filename /= Use_Current then
1005          File_Table.Init (Session.Data.Files);
1006          Add_File (Filename, Session);
1007       end if;
1008
1009       if Separators /= Use_Current then
1010          Set_Field_Separators (Separators, Session);
1011       end if;
1012
1013       Open_Next_File (Session);
1014
1015    exception
1016       when End_Error =>
1017          raise File_Error;
1018    end Open;
1019
1020    --------------------
1021    -- Open_Next_File --
1022    --------------------
1023
1024    procedure Open_Next_File
1025      (Session : Session_Type := Current_Session)
1026    is
1027       Files : File_Table.Instance renames Session.Data.Files;
1028
1029    begin
1030       if Text_IO.Is_Open (Session.Data.Current_File) then
1031          Text_IO.Close (Session.Data.Current_File);
1032       end if;
1033
1034       Session.Data.File_Index := Session.Data.File_Index + 1;
1035
1036       --  If there are no mores file in the table, raise End_Error
1037
1038       if Session.Data.File_Index > File_Table.Last (Files) then
1039          raise End_Error;
1040       end if;
1041
1042       Text_IO.Open
1043         (File => Session.Data.Current_File,
1044          Name => Files.Table (Session.Data.File_Index).all,
1045          Mode => Text_IO.In_File);
1046    end Open_Next_File;
1047
1048    -----------
1049    -- Parse --
1050    -----------
1051
1052    procedure Parse
1053      (Separators : String       := Use_Current;
1054       Filename   : String       := Use_Current;
1055       Session    : Session_Type := Current_Session)
1056    is
1057       Filter_Active : Boolean;
1058       pragma Unreferenced (Filter_Active);
1059
1060    begin
1061       Open (Separators, Filename, Session);
1062
1063       while not End_Of_Data (Session) loop
1064          Get_Line (None, Session);
1065          Filter_Active := Apply_Filters (Session);
1066       end loop;
1067
1068       Close (Session);
1069    end Parse;
1070
1071    ---------------------
1072    -- Raise_With_Info --
1073    ---------------------
1074
1075    procedure Raise_With_Info
1076      (E       : Exceptions.Exception_Id;
1077       Message : String;
1078       Session : Session_Type)
1079    is
1080       function Filename return String;
1081       --  Returns current filename and "??" if the informations is not
1082       --  available.
1083
1084       function Line return String;
1085       --  Returns current line number without the leading space
1086
1087       --------------
1088       -- Filename --
1089       --------------
1090
1091       function Filename return String is
1092          File : constant String := AWK.File (Session);
1093
1094       begin
1095          if File = "" then
1096             return "??";
1097          else
1098             return File;
1099          end if;
1100       end Filename;
1101
1102       ----------
1103       -- Line --
1104       ----------
1105
1106       function Line return String is
1107          L : constant String := Natural'Image (Session.Data.FNR);
1108
1109       begin
1110          return L (2 .. L'Last);
1111       end Line;
1112
1113    --  Start of processing for Raise_With_Info
1114
1115    begin
1116       Exceptions.Raise_Exception
1117         (E,
1118          '[' & Filename & ':' & Line & "] " & Message);
1119       raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1120    end Raise_With_Info;
1121
1122    ---------------
1123    -- Read_Line --
1124    ---------------
1125
1126    procedure Read_Line (Session : Session_Type) is
1127
1128       function Read_Line return String;
1129       --  Read a line in the current file. This implementation is recursive
1130       --  and does not have a limitation on the line length.
1131
1132       NR  : Natural renames Session.Data.NR;
1133       FNR : Natural renames Session.Data.FNR;
1134
1135       function Read_Line return String is
1136          Buffer : String (1 .. 1_024);
1137          Last   : Natural;
1138
1139       begin
1140          Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1141
1142          if Last = Buffer'Last then
1143             return Buffer & Read_Line;
1144          else
1145             return Buffer (1 .. Last);
1146          end if;
1147       end Read_Line;
1148
1149    --  Start of processing for Read_Line
1150
1151    begin
1152       if End_Of_File (Session) then
1153          Open_Next_File (Session);
1154          FNR := 0;
1155       end if;
1156
1157       Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1158
1159       NR := NR + 1;
1160       FNR := FNR + 1;
1161    end Read_Line;
1162
1163    --------------
1164    -- Register --
1165    --------------
1166
1167    procedure Register
1168      (Field   : Count;
1169       Pattern : String;
1170       Action  : Action_Callback;
1171       Session : Session_Type := Current_Session)
1172    is
1173       Filters   : Pattern_Action_Table.Instance renames Session.Data.Filters;
1174       U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1175
1176    begin
1177       Pattern_Action_Table.Increment_Last (Filters);
1178
1179       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1180         (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1181          Action  => new Actions.Simple_Action'(Proc => Action));
1182    end Register;
1183
1184    procedure Register
1185      (Field   : Count;
1186       Pattern : GNAT.Regpat.Pattern_Matcher;
1187       Action  : Action_Callback;
1188       Session : Session_Type := Current_Session)
1189    is
1190       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1191
1192       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1193                     new Regpat.Pattern_Matcher'(Pattern);
1194    begin
1195       Pattern_Action_Table.Increment_Last (Filters);
1196
1197       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1198         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1199          Action  => new Actions.Simple_Action'(Proc => Action));
1200    end Register;
1201
1202    procedure Register
1203      (Field   : Count;
1204       Pattern : GNAT.Regpat.Pattern_Matcher;
1205       Action  : Match_Action_Callback;
1206       Session : Session_Type := Current_Session)
1207    is
1208       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1209
1210       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1211                     new Regpat.Pattern_Matcher'(Pattern);
1212    begin
1213       Pattern_Action_Table.Increment_Last (Filters);
1214
1215       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1216         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1217          Action  => new Actions.Match_Action'(Proc => Action));
1218    end Register;
1219
1220    procedure Register
1221      (Pattern : Pattern_Callback;
1222       Action  : Action_Callback;
1223       Session : Session_Type := Current_Session)
1224    is
1225       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1226
1227    begin
1228       Pattern_Action_Table.Increment_Last (Filters);
1229
1230       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1231         (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1232          Action  => new Actions.Simple_Action'(Proc => Action));
1233    end Register;
1234
1235    procedure Register
1236      (Action  : Action_Callback;
1237       Session : Session_Type := Current_Session)
1238    is
1239    begin
1240       Register (Always_True'Access, Action, Session);
1241    end Register;
1242
1243    -----------------
1244    -- Set_Current --
1245    -----------------
1246
1247    procedure Set_Current (Session : Session_Type) is
1248    begin
1249       Cur_Session.Data := Session.Data;
1250    end Set_Current;
1251
1252    --------------------------
1253    -- Set_Field_Separators --
1254    --------------------------
1255
1256    procedure Set_Field_Separators
1257      (Separators : String       := Default_Separators;
1258       Session    : Session_Type := Current_Session)
1259    is
1260    begin
1261       Free (Session.Data.Separators);
1262
1263       Session.Data.Separators :=
1264         new Split.Separator'(Separators'Length, Separators);
1265
1266       --  If there is a current line read, split it according to the new
1267       --  separators.
1268
1269       if Session.Data.Current_Line /= Null_Unbounded_String then
1270          Split_Line (Session);
1271       end if;
1272    end Set_Field_Separators;
1273
1274    ----------------------
1275    -- Set_Field_Widths --
1276    ----------------------
1277
1278    procedure Set_Field_Widths
1279      (Field_Widths : Widths_Set;
1280       Session      : Session_Type := Current_Session) is
1281
1282    begin
1283       Free (Session.Data.Separators);
1284
1285       Session.Data.Separators :=
1286         new Split.Column'(Field_Widths'Length, Field_Widths);
1287
1288       --  If there is a current line read, split it according to
1289       --  the new separators.
1290
1291       if Session.Data.Current_Line /= Null_Unbounded_String then
1292          Split_Line (Session);
1293       end if;
1294    end Set_Field_Widths;
1295
1296    ----------------
1297    -- Split_Line --
1298    ----------------
1299
1300    procedure Split_Line (Session : Session_Type) is
1301       Fields : Field_Table.Instance renames Session.Data.Fields;
1302
1303    begin
1304       Field_Table.Init (Fields);
1305
1306       Split.Current_Line (Session.Data.Separators.all, Session);
1307    end Split_Line;
1308
1309 begin
1310    --  We have declared two sessions but both should share the same data.
1311    --  The current session must point to the default session as its initial
1312    --  value. So first we release the session data then we set current
1313    --  session data to point to default session data.
1314
1315    Free (Cur_Session.Data);
1316    Cur_Session.Data := Def_Session.Data;
1317 end GNAT.AWK;