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