gcc/ada/g-awk.adb

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